annotate src/alloc.c @ 108544:0989e87620a6

* src/Makefile.in (SHELL): Move outside cpp section. Some comment formatting.
author Glenn Morris <rgm@gnu.org>
date Thu, 13 May 2010 19:32:29 -0700
parents bef5d1738c0b
children 734073f5d073
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.
57098
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
2 Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999,
106815
1d1d5d9bd884 Add 2010 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 105986
diff changeset
3 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
79759
fc2bcd2a8aad Add 2008 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 78811
diff changeset
4 Free Software Foundation, Inc.
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6 This file is part of GNU Emacs.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7
94963
8971ddf55736 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94293
diff changeset
8 GNU Emacs is free software: you can redistribute it and/or modify
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
9 it under the terms of the GNU General Public License as published by
94963
8971ddf55736 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94293
diff changeset
10 the Free Software Foundation, either version 3 of the License, or
8971ddf55736 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94293
diff changeset
11 (at your option) any later version.
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 GNU Emacs is distributed in the hope that it will be useful,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16 GNU General Public License for more details.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
94963
8971ddf55736 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94293
diff changeset
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
20
26088
b7aa6ac26872 Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents: 25762
diff changeset
21 #include <config.h>
28374
7a3e8a76057b Include stdio.h. Test STDC_HEADERS, not __STDC__.
Dave Love <fx@gnu.org>
parents: 28365
diff changeset
22 #include <stdio.h>
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
23 #include <limits.h> /* For CHAR_BIT. */
105669
68dd71358159 * alloc.c: Do not define struct catchtag.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 104582
diff changeset
24 #include <setjmp.h>
26088
b7aa6ac26872 Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents: 25762
diff changeset
25
69876
272487a77b8e [STDC_HEADERS]: Include stddef.h.
Eli Zaretskii <eliz@gnu.org>
parents: 69873
diff changeset
26 #ifdef STDC_HEADERS
272487a77b8e [STDC_HEADERS]: Include stddef.h.
Eli Zaretskii <eliz@gnu.org>
parents: 69873
diff changeset
27 #include <stddef.h> /* For offsetof, used by PSEUDOVECSIZE. */
272487a77b8e [STDC_HEADERS]: Include stddef.h.
Eli Zaretskii <eliz@gnu.org>
parents: 69873
diff changeset
28 #endif
272487a77b8e [STDC_HEADERS]: Include stddef.h.
Eli Zaretskii <eliz@gnu.org>
parents: 69873
diff changeset
29
47185
2ff45b08a155 (display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents: 46833
diff changeset
30 #ifdef ALLOC_DEBUG
2ff45b08a155 (display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents: 46833
diff changeset
31 #undef INLINE
2ff45b08a155 (display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents: 46833
diff changeset
32 #endif
2ff45b08a155 (display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents: 46833
diff changeset
33
3003
5a73d384f45e * syssignal.h: Don't #include <signal.h>
Jim Blandy <jimb@redhat.com>
parents: 2961
diff changeset
34 #include <signal.h>
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
35
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
36 #ifdef HAVE_GTK_AND_PTHREAD
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
37 #include <pthread.h>
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
38 #endif
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
39
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
40 /* This file is part of the core Lisp implementation, and thus must
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
41 deal with the real data structures. If the Lisp implementation is
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
42 replaced, this file likely will not be used. */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
43
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
44 #undef HIDE_LISP_IMPLEMENTATION
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
45 #include "lisp.h"
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
46 #include "process.h"
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
47 #include "intervals.h"
356
5b180834eacf *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 300
diff changeset
48 #include "puresize.h"
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
49 #include "buffer.h"
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
50 #include "window.h"
31102
6a0caa788013 Include keyboard.h before frame.h.
Andrew Innes <andrewi@gnu.org>
parents: 30914
diff changeset
51 #include "keyboard.h"
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
52 #include "frame.h"
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
53 #include "blockinput.h"
88353
8e996bb689ca Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 43314
diff changeset
54 #include "character.h"
638
40b255f55df3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 624
diff changeset
55 #include "syssignal.h"
84693
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
56 #include "termhooks.h" /* For struct terminal. */
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
57 #include <setjmp.h>
638
40b255f55df3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 624
diff changeset
58
52547
623355edbb1d (GC_MALLOC_CHECK): Move conditional undef after lisp.h.
Dave Love <fx@gnu.org>
parents: 52475
diff changeset
59 /* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
623355edbb1d (GC_MALLOC_CHECK): Move conditional undef after lisp.h.
Dave Love <fx@gnu.org>
parents: 52475
diff changeset
60 memory. Can do this only if using gmalloc.c. */
623355edbb1d (GC_MALLOC_CHECK): Move conditional undef after lisp.h.
Dave Love <fx@gnu.org>
parents: 52475
diff changeset
61
623355edbb1d (GC_MALLOC_CHECK): Move conditional undef after lisp.h.
Dave Love <fx@gnu.org>
parents: 52475
diff changeset
62 #if defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC
623355edbb1d (GC_MALLOC_CHECK): Move conditional undef after lisp.h.
Dave Love <fx@gnu.org>
parents: 52475
diff changeset
63 #undef GC_MALLOC_CHECK
623355edbb1d (GC_MALLOC_CHECK): Move conditional undef after lisp.h.
Dave Love <fx@gnu.org>
parents: 52475
diff changeset
64 #endif
623355edbb1d (GC_MALLOC_CHECK): Move conditional undef after lisp.h.
Dave Love <fx@gnu.org>
parents: 52475
diff changeset
65
30784
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
66 #ifdef HAVE_UNISTD_H
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
67 #include <unistd.h>
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
68 #else
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
69 extern POINTER_TYPE *sbrk ();
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
70 #endif
12096
cdc859dd813b Declare sbrk.
Karl Heuer <kwzh@gnu.org>
parents: 11892
diff changeset
71
67216
fc58516afccd Include fcntl.h. Define O_WRONLY if not defined.
Kim F. Storm <storm@cua.dk>
parents: 66889
diff changeset
72 #ifdef HAVE_FCNTL_H
fc58516afccd Include fcntl.h. Define O_WRONLY if not defined.
Kim F. Storm <storm@cua.dk>
parents: 66889
diff changeset
73 #define INCLUDED_FCNTL
fc58516afccd Include fcntl.h. Define O_WRONLY if not defined.
Kim F. Storm <storm@cua.dk>
parents: 66889
diff changeset
74 #include <fcntl.h>
fc58516afccd Include fcntl.h. Define O_WRONLY if not defined.
Kim F. Storm <storm@cua.dk>
parents: 66889
diff changeset
75 #endif
fc58516afccd Include fcntl.h. Define O_WRONLY if not defined.
Kim F. Storm <storm@cua.dk>
parents: 66889
diff changeset
76 #ifndef O_WRONLY
fc58516afccd Include fcntl.h. Define O_WRONLY if not defined.
Kim F. Storm <storm@cua.dk>
parents: 66889
diff changeset
77 #define O_WRONLY 1
fc58516afccd Include fcntl.h. Define O_WRONLY if not defined.
Kim F. Storm <storm@cua.dk>
parents: 66889
diff changeset
78 #endif
fc58516afccd Include fcntl.h. Define O_WRONLY if not defined.
Kim F. Storm <storm@cua.dk>
parents: 66889
diff changeset
79
72177
4eba80d54b43 [WINDOWSNT]: Include fcntl.h, to fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 72167
diff changeset
80 #ifdef WINDOWSNT
4eba80d54b43 [WINDOWSNT]: Include fcntl.h, to fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 72167
diff changeset
81 #include <fcntl.h>
72288
94e8cc9b752d Include w32.h.
Eli Zaretskii <eliz@gnu.org>
parents: 72177
diff changeset
82 #include "w32.h"
72177
4eba80d54b43 [WINDOWSNT]: Include fcntl.h, to fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 72167
diff changeset
83 #endif
4eba80d54b43 [WINDOWSNT]: Include fcntl.h, to fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 72167
diff changeset
84
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
85 #ifdef DOUG_LEA_MALLOC
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
86
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
87 #include <malloc.h>
31892
2f3d88ac2b38 (__malloc_size_t) [DOUG_LEA_MALLOC]: Don't redefine it.
Dave Love <fx@gnu.org>
parents: 31889
diff changeset
88 /* 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
89 #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
90 #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
91 #endif
23973
2eb9e2f5aa33 (MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 23958
diff changeset
92
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
93 /* 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
94 value that explicitly means "no limit". */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
95
23973
2eb9e2f5aa33 (MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 23958
diff changeset
96 #define MMAP_MAX_AREAS 100000000
2eb9e2f5aa33 (MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 23958
diff changeset
97
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
98 #else /* not DOUG_LEA_MALLOC */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
99
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
100 /* 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
101
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
102 #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
103 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
104 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
105
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
106 #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
107
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
108 #if ! defined (SYSTEM_MALLOC) && defined (HAVE_GTK_AND_PTHREAD)
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
109
58831
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
110 /* When GTK uses the file chooser dialog, different backends can be loaded
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
111 dynamically. One such a backend is the Gnome VFS backend that gets loaded
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
112 if you run Gnome. That backend creates several threads and also allocates
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
113 memory with malloc.
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
114
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
115 If Emacs sets malloc hooks (! SYSTEM_MALLOC) and the emacs_blocked_*
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
116 functions below are called from malloc, there is a chance that one
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
117 of these threads preempts the Emacs main thread and the hook variables
58986
59945307b86b * syssignal.h: Declare main_thread.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58831
diff changeset
118 end up in an inconsistent state. So we have a mutex to prevent that (note
58831
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
119 that the backend handles concurrent access to malloc within its own threads
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
120 but Emacs code running in the main thread is not included in that control).
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
121
59359
1678d14c4109 (refill_memory_reserve): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59314
diff changeset
122 When UNBLOCK_INPUT is called, reinvoke_input_signal may be called. If this
58831
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
123 happens in one of the backend threads we will have two threads that tries
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
124 to run Emacs code at once, and the code is not prepared for that.
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
125 To prevent that, we only call BLOCK/UNBLOCK from the main thread. */
408c5135b0a2 * alloc.c: Add comment about the reason for (UN)BLOCK_INPUT_ALLOC.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58818
diff changeset
126
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
127 static pthread_mutex_t alloc_mutex;
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
128
75192
a62f8b0494a2 (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Use pthread_equal,
Jan Djärv <jan.h.d@swipnet.se>
parents: 73964
diff changeset
129 #define BLOCK_INPUT_ALLOC \
a62f8b0494a2 (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Use pthread_equal,
Jan Djärv <jan.h.d@swipnet.se>
parents: 73964
diff changeset
130 do \
a62f8b0494a2 (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Use pthread_equal,
Jan Djärv <jan.h.d@swipnet.se>
parents: 73964
diff changeset
131 { \
a62f8b0494a2 (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Use pthread_equal,
Jan Djärv <jan.h.d@swipnet.se>
parents: 73964
diff changeset
132 if (pthread_equal (pthread_self (), main_thread)) \
75406
b176aeeb7253 (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Use
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 75348
diff changeset
133 BLOCK_INPUT; \
75192
a62f8b0494a2 (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Use pthread_equal,
Jan Djärv <jan.h.d@swipnet.se>
parents: 73964
diff changeset
134 pthread_mutex_lock (&alloc_mutex); \
a62f8b0494a2 (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Use pthread_equal,
Jan Djärv <jan.h.d@swipnet.se>
parents: 73964
diff changeset
135 } \
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
136 while (0)
75192
a62f8b0494a2 (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Use pthread_equal,
Jan Djärv <jan.h.d@swipnet.se>
parents: 73964
diff changeset
137 #define UNBLOCK_INPUT_ALLOC \
a62f8b0494a2 (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Use pthread_equal,
Jan Djärv <jan.h.d@swipnet.se>
parents: 73964
diff changeset
138 do \
a62f8b0494a2 (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Use pthread_equal,
Jan Djärv <jan.h.d@swipnet.se>
parents: 73964
diff changeset
139 { \
a62f8b0494a2 (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Use pthread_equal,
Jan Djärv <jan.h.d@swipnet.se>
parents: 73964
diff changeset
140 pthread_mutex_unlock (&alloc_mutex); \
a62f8b0494a2 (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Use pthread_equal,
Jan Djärv <jan.h.d@swipnet.se>
parents: 73964
diff changeset
141 if (pthread_equal (pthread_self (), main_thread)) \
75406
b176aeeb7253 (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Use
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 75348
diff changeset
142 UNBLOCK_INPUT; \
75192
a62f8b0494a2 (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Use pthread_equal,
Jan Djärv <jan.h.d@swipnet.se>
parents: 73964
diff changeset
143 } \
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
144 while (0)
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
145
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
146 #else /* SYSTEM_MALLOC || not HAVE_GTK_AND_PTHREAD */
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
147
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
148 #define BLOCK_INPUT_ALLOC BLOCK_INPUT
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
149 #define UNBLOCK_INPUT_ALLOC UNBLOCK_INPUT
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
150
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
151 #endif /* SYSTEM_MALLOC || not HAVE_GTK_AND_PTHREAD */
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
152
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
153 /* 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
154
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
155 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
156
66547
9373f926904a (BYTES_USED): Use uordblks, not arena.
Richard M. Stallman <rms@gnu.org>
parents: 66541
diff changeset
157 static __malloc_size_t bytes_used_when_reconsidered;
9373f926904a (BYTES_USED): Use uordblks, not arena.
Richard M. Stallman <rms@gnu.org>
parents: 66541
diff changeset
158
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
159 /* 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
160 to a struct Lisp_String. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
161
51985
b52e88c3d6d0 (MARK_STRING, UNMARK_STRING, STRING_MARKED_P)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51974
diff changeset
162 #define MARK_STRING(S) ((S)->size |= ARRAY_MARK_FLAG)
b52e88c3d6d0 (MARK_STRING, UNMARK_STRING, STRING_MARKED_P)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51974
diff changeset
163 #define UNMARK_STRING(S) ((S)->size &= ~ARRAY_MARK_FLAG)
59657
f3aa25eacdb3 (STRING_MARKED_P, VECTOR_MARKED_P): Return boolean.
Kim F. Storm <storm@cua.dk>
parents: 59400
diff changeset
164 #define STRING_MARKED_P(S) (((S)->size & ARRAY_MARK_FLAG) != 0)
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
165
51683
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
166 #define VECTOR_MARK(V) ((V)->size |= ARRAY_MARK_FLAG)
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
167 #define VECTOR_UNMARK(V) ((V)->size &= ~ARRAY_MARK_FLAG)
59657
f3aa25eacdb3 (STRING_MARKED_P, VECTOR_MARKED_P): Return boolean.
Kim F. Storm <storm@cua.dk>
parents: 59400
diff changeset
168 #define VECTOR_MARKED_P(V) (((V)->size & ARRAY_MARK_FLAG) != 0)
51683
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
169
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
170 /* 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
171 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
172 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
173 strings. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
174
51683
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
175 #define GC_STRING_BYTES(S) (STRING_BYTES (S))
51985
b52e88c3d6d0 (MARK_STRING, UNMARK_STRING, STRING_MARKED_P)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51974
diff changeset
176 #define GC_STRING_CHARS(S) ((S)->size & ~ARRAY_MARK_FLAG)
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
177
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
178 /* 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
179
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
180 int consing_since_gc;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
181
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
182 /* 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
183
43713
f92c4d87863a Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43314
diff changeset
184 EMACS_INT cons_cells_consed;
f92c4d87863a Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43314
diff changeset
185 EMACS_INT floats_consed;
f92c4d87863a Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43314
diff changeset
186 EMACS_INT vector_cells_consed;
f92c4d87863a Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43314
diff changeset
187 EMACS_INT symbols_consed;
f92c4d87863a Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43314
diff changeset
188 EMACS_INT string_chars_consed;
f92c4d87863a Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43314
diff changeset
189 EMACS_INT misc_objects_consed;
f92c4d87863a Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43314
diff changeset
190 EMACS_INT intervals_consed;
f92c4d87863a Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43314
diff changeset
191 EMACS_INT strings_consed;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
192
64611
47f158dcf216 (gc_cons_threshold): Not static.
Richard M. Stallman <rms@gnu.org>
parents: 64273
diff changeset
193 /* Minimum number of bytes of consing since GC before next GC. */
47f158dcf216 (gc_cons_threshold): Not static.
Richard M. Stallman <rms@gnu.org>
parents: 64273
diff changeset
194
47f158dcf216 (gc_cons_threshold): Not static.
Richard M. Stallman <rms@gnu.org>
parents: 64273
diff changeset
195 EMACS_INT gc_cons_threshold;
47f158dcf216 (gc_cons_threshold): Not static.
Richard M. Stallman <rms@gnu.org>
parents: 64273
diff changeset
196
47f158dcf216 (gc_cons_threshold): Not static.
Richard M. Stallman <rms@gnu.org>
parents: 64273
diff changeset
197 /* Similar minimum, computed from Vgc_cons_percentage. */
47f158dcf216 (gc_cons_threshold): Not static.
Richard M. Stallman <rms@gnu.org>
parents: 64273
diff changeset
198
47f158dcf216 (gc_cons_threshold): Not static.
Richard M. Stallman <rms@gnu.org>
parents: 64273
diff changeset
199 EMACS_INT gc_relative_threshold;
47f158dcf216 (gc_cons_threshold): Not static.
Richard M. Stallman <rms@gnu.org>
parents: 64273
diff changeset
200
64267
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
201 static Lisp_Object Vgc_cons_percentage;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
202
66530
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
203 /* Minimum number of bytes of consing since GC before next GC,
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
204 when memory is full. */
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
205
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
206 EMACS_INT memory_full_cons_threshold;
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
207
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
208 /* Nonzero during GC. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
209
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
210 int gc_in_progress;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
211
50745
fedd03de0f46 (abort_on_gc): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 50626
diff changeset
212 /* Nonzero means abort if try to GC.
fedd03de0f46 (abort_on_gc): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 50626
diff changeset
213 This is for code which is written on the assumption that
fedd03de0f46 (abort_on_gc): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 50626
diff changeset
214 no GC will happen, so as to verify that assumption. */
fedd03de0f46 (abort_on_gc): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 50626
diff changeset
215
fedd03de0f46 (abort_on_gc): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 50626
diff changeset
216 int abort_on_gc;
fedd03de0f46 (abort_on_gc): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 50626
diff changeset
217
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
218 /* 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
219
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
220 int garbage_collection_messages;
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
221
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
222 #ifndef VIRT_ADDR_VARIES
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
223 extern
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
224 #endif /* VIRT_ADDR_VARIES */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
225 int malloc_sbrk_used;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
226
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
227 #ifndef VIRT_ADDR_VARIES
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
228 extern
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
229 #endif /* VIRT_ADDR_VARIES */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
230 int malloc_sbrk_unused;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
231
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
232 /* 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
233
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
234 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
235 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
236 static int total_free_floats, total_floats;
19332
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
237
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
238 /* Points to memory space allocated as "spare", to be freed if we run
66530
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
239 out of memory. We keep one large block, four cons-blocks, and
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
240 two string blocks. */
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
241
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
242 static char *spare_memory[7];
66530
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
243
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
244 /* Amount of spare memory to keep in large reserve block. */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
245
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
246 #define SPARE_MEMORY (1 << 14)
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
247
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
248 /* 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
249
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
250 static int malloc_hysteresis;
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
251
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
252 /* 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
253
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
254 Lisp_Object Vpurify_flag;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
255
46305
fed6b815dbeb (Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 46293
diff changeset
256 /* Non-nil means we are handling a memory-full error. */
fed6b815dbeb (Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 46293
diff changeset
257
fed6b815dbeb (Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 46293
diff changeset
258 Lisp_Object Vmemory_full;
fed6b815dbeb (Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 46293
diff changeset
259
57137
646750cbd594 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 57098
diff changeset
260 /* Initialize it to a nonzero value to force it into data space
646750cbd594 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 57098
diff changeset
261 (rather than bss space). That way unexec will remap it into text
646750cbd594 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 57098
diff changeset
262 space (pure), on some systems. We have not implemented the
646750cbd594 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 57098
diff changeset
263 remapping on more recent systems because this is less important
646750cbd594 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 57098
diff changeset
264 nowadays than in the days of small memories and timesharing. */
51908
cb3976b5e59f (pure, staticvec): Initialize these arrays to nonzero, so that they're
Paul Eggert <eggert@twinsun.com>
parents: 51907
diff changeset
265
78593
5d078cae9374 (pure): Round PURESIZE up.
Andreas Schwab <schwab@suse.de>
parents: 78260
diff changeset
266 EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,};
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
267 #define PUREBEG (char *) pure
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
268
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
269 /* 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
270
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
271 static char *purebeg;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
272 static size_t pure_size;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
273
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
274 /* 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
275 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
276
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
277 static size_t pure_bytes_used_before_overflow;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
278
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
279 /* 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
280
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
281 #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
282 (((PNTR_COMPARISON_TYPE) (P) \
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
283 < (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
284 && ((PNTR_COMPARISON_TYPE) (P) \
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
285 >= (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
286
72027
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
287 /* Total number of bytes allocated in pure storage. */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
288
43713
f92c4d87863a Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43314
diff changeset
289 EMACS_INT pure_bytes_used;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
290
72027
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
291 /* Index in pure at which next pure Lisp object will be allocated.. */
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
292
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
293 static EMACS_INT pure_bytes_used_lisp;
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
294
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
295 /* Number of bytes allocated for non-Lisp objects in pure storage. */
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
296
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
297 static EMACS_INT pure_bytes_used_non_lisp;
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
298
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
299 /* 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
300 displayed. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
301
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
302 char *pending_malloc_warning;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
303
6116
64417bbbb128 (memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents: 5874
diff changeset
304 /* 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
305
46305
fed6b815dbeb (Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 46293
diff changeset
306 Lisp_Object Vmemory_signal_data;
6116
64417bbbb128 (memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents: 5874
diff changeset
307
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
308 /* Maximum amount of C stack to save when a GC happens. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
309
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
310 #ifndef MAX_SAVE_STACK
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
311 #define MAX_SAVE_STACK 16000
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
312 #endif
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
313
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
314 /* 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
315
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
316 static char *stack_copy;
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
317 static int stack_copy_size;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
318
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
319 /* 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
320 Currently not used. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
321
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
322 static int ignore_warnings;
1318
0edeba6fc9fc Fixed typos.
Joseph Arceneaux <jla@gnu.org>
parents: 1300
diff changeset
323
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
324 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
325
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
326 /* Hook run after GC has finished. */
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
327
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
328 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
329
49529
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
330 Lisp_Object Vgc_elapsed; /* accumulated elapsed time in GC */
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
331 EMACS_INT gcs_done; /* accumulated GCs */
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
332
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
333 static void mark_buffer P_ ((Lisp_Object));
84693
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
334 static void mark_terminals P_ ((void));
51578
42f25a716cb8 (mark_kboards): Move to keyboard.c.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51318
diff changeset
335 extern void mark_kboards P_ ((void));
82988
f82e3a6f5ccb A few more bugfixes and new features.
Karoly Lorentey <lorentey@elte.hu>
parents: 53093
diff changeset
336 extern void mark_ttys P_ ((void));
55798
a1bb695e9a0c (struct backtrace): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55767
diff changeset
337 extern void mark_backtrace P_ ((void));
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
338 static void gc_sweep P_ ((void));
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
339 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
340 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
341
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
342 #ifdef HAVE_WINDOW_SYSTEM
59400
eeb8b96d077d (mark_fringe_data): Declare extern.
Kim F. Storm <storm@cua.dk>
parents: 59359
diff changeset
343 extern void mark_fringe_data P_ ((void));
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
344 #endif /* HAVE_WINDOW_SYSTEM */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
345
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
346 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
347 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
348 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
349 static void sweep_strings P_ ((void));
20495
db1be942dc12 (Fgarbage_collect):
Richard M. Stallman <rms@gnu.org>
parents: 20391
diff changeset
350
db1be942dc12 (Fgarbage_collect):
Richard M. Stallman <rms@gnu.org>
parents: 20391
diff changeset
351 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
352
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
353 /* 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
354 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
355 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
356
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
357 enum mem_type
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
358 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
359 MEM_TYPE_NON_LISP,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
360 MEM_TYPE_BUFFER,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
361 MEM_TYPE_CONS,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
362 MEM_TYPE_STRING,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
363 MEM_TYPE_MISC,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
364 MEM_TYPE_SYMBOL,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
365 MEM_TYPE_FLOAT,
84978
33b7fe948502 (enum mem_type): Replace all vector subtypes -> MEM_TYPE_VECTORLIKE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84977
diff changeset
366 /* We used to keep separate mem_types for subtypes of vectors such as
33b7fe948502 (enum mem_type): Replace all vector subtypes -> MEM_TYPE_VECTORLIKE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84977
diff changeset
367 process, hash_table, frame, terminal, and window, but we never made
33b7fe948502 (enum mem_type): Replace all vector subtypes -> MEM_TYPE_VECTORLIKE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84977
diff changeset
368 use of the distinction, so it only caused source-code complexity
33b7fe948502 (enum mem_type): Replace all vector subtypes -> MEM_TYPE_VECTORLIKE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84977
diff changeset
369 and runtime slowdown. Minor but pointless. */
33b7fe948502 (enum mem_type): Replace all vector subtypes -> MEM_TYPE_VECTORLIKE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84977
diff changeset
370 MEM_TYPE_VECTORLIKE
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
371 };
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
372
66530
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
373 static POINTER_TYPE *lisp_align_malloc P_ ((size_t, enum mem_type));
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
374 static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type));
66662
6ab8d86f8a2b (refill_memory_reserve): Move decl out of conditionals.
Richard M. Stallman <rms@gnu.org>
parents: 66547
diff changeset
375 void refill_memory_reserve ();
6ab8d86f8a2b (refill_memory_reserve): Move decl out of conditionals.
Richard M. Stallman <rms@gnu.org>
parents: 66547
diff changeset
376
66530
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
377
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
378 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
27746
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
379
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
380 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
381 #include <stdio.h> /* For fprintf. */
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
382 #endif
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
383
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
384 /* 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
385 on free lists recognizable in O(1). */
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
386
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
387 static Lisp_Object Vdead;
27746
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
388
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
389 #ifdef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
390
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
391 enum mem_type allocated_mem_type;
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
392 static int dont_register_blocks;
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
393
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
394 #endif /* GC_MALLOC_CHECK */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
395
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
396 /* 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
397 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
398 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
399 is freed.
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
400
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
401 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
402 properties:
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
403
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
404 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
405 2. Every leaf is black.
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
406 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
407 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
408 the same number of black nodes.
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
409 5. The root is always black.
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
410
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
411 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
412 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
413
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
414 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
415 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
416 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
417 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
418 describe them. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
419
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
420 struct mem_node
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
421 {
48907
3bf6323fe318 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 48316
diff changeset
422 /* Children of this node. These pointers are never NULL. When there
3bf6323fe318 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 48316
diff changeset
423 is no child, the value is MEM_NIL, which points to a dummy node. */
3bf6323fe318 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 48316
diff changeset
424 struct mem_node *left, *right;
3bf6323fe318 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 48316
diff changeset
425
3bf6323fe318 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 48316
diff changeset
426 /* The parent of this node. In the root node, this is NULL. */
3bf6323fe318 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 48316
diff changeset
427 struct mem_node *parent;
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
428
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
429 /* Start and end of allocated region. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
430 void *start, *end;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
431
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
432 /* Node color. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
433 enum {MEM_BLACK, MEM_RED} color;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
434
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
435 /* Memory type. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
436 enum mem_type type;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
437 };
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
438
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
439 /* Base address of stack. Set in main. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
440
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
441 Lisp_Object *stack_base;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
442
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
443 /* 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
444
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
445 static struct mem_node *mem_root;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
446
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
447 /* Lowest and highest known address in the heap. */
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
448
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
449 static void *min_heap_address, *max_heap_address;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
450
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
451 /* Sentinel node of the tree. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
452
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
453 static struct mem_node mem_z;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
454 #define MEM_NIL &mem_z
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
455
30914
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
456 static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type));
84978
33b7fe948502 (enum mem_type): Replace all vector subtypes -> MEM_TYPE_VECTORLIKE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84977
diff changeset
457 static struct Lisp_Vector *allocate_vectorlike P_ ((EMACS_INT));
30784
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
458 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
459 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
460 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
461 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
462 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
463 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
464 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
465 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
466 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
467 static void mark_maybe_object P_ ((Lisp_Object));
73964
b684c6771753 (mark_memory): New argument OFFSET. All uses changed.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72537
diff changeset
468 static void mark_memory P_ ((void *, void *, int));
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
469 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
470 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
471 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
472 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
473 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
474 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
475 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
476 static INLINE struct mem_node *mem_find P_ ((void *));
66530
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
477
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
478
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
479 #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
480 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
481 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
482
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
483 #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
484
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
485 /* Recording what needs to be marked for gc. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
486
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
487 struct gcpro *gcprolist;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
488
51908
cb3976b5e59f (pure, staticvec): Initialize these arrays to nonzero, so that they're
Paul Eggert <eggert@twinsun.com>
parents: 51907
diff changeset
489 /* Addresses of staticpro'd variables. Initialize it to a nonzero
cb3976b5e59f (pure, staticvec): Initialize these arrays to nonzero, so that they're
Paul Eggert <eggert@twinsun.com>
parents: 51907
diff changeset
490 value; otherwise some compilers put it into BSS. */
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
491
97230
a279d4c66e68 (NSTATICS): Bump to 0x640.
Eli Zaretskii <eliz@gnu.org>
parents: 96602
diff changeset
492 #define NSTATICS 0x640
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
493 static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
494
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
495 /* Index of next unused slot in staticvec. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
496
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
497 static int staticidx = 0;
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
498
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
499 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
500
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
501
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
502 /* 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
503 ALIGNMENT must be a power of 2. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
504
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
505 #define ALIGN(ptr, ALIGNMENT) \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
506 ((POINTER_TYPE *) ((((EMACS_UINT)(ptr)) + (ALIGNMENT) - 1) \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
507 & ~((ALIGNMENT) - 1)))
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
508
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
509
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
510
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
511 /************************************************************************
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
512 Malloc
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
513 ************************************************************************/
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
514
47185
2ff45b08a155 (display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents: 46833
diff changeset
515 /* Function malloc calls this if it finds we are near exhausting storage. */
20375
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
516
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
517 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
518 malloc_warning (str)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
519 char *str;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
520 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
521 pending_malloc_warning = str;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
522 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
523
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
524
47185
2ff45b08a155 (display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents: 46833
diff changeset
525 /* Display an already-pending malloc warning. */
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
526
20375
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
527 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
528 display_malloc_warning ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
529 {
47185
2ff45b08a155 (display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents: 46833
diff changeset
530 call3 (intern ("display-warning"),
2ff45b08a155 (display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents: 46833
diff changeset
531 intern ("alloc"),
2ff45b08a155 (display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents: 46833
diff changeset
532 build_string (pending_malloc_warning),
2ff45b08a155 (display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents: 46833
diff changeset
533 intern ("emergency"));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
534 pending_malloc_warning = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
535 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
536
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
537
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
538 #ifdef DOUG_LEA_MALLOC
66547
9373f926904a (BYTES_USED): Use uordblks, not arena.
Richard M. Stallman <rms@gnu.org>
parents: 66541
diff changeset
539 # define BYTES_USED (mallinfo ().uordblks)
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
540 #else
17831
9238a2254a23 (BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents: 17348
diff changeset
541 # 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
542 #endif
65832
5159ee08b219 (refill_memory_reserve): Conditionalize the body, not the function's existence.
Richard M. Stallman <rms@gnu.org>
parents: 65764
diff changeset
543
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
544 /* 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
545
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
546 void
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
547 buffer_memory_full ()
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
548 {
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
549 /* 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
550 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
551 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
552 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
553 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
554 malloc. */
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
555
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
556 #ifndef REL_ALLOC
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
557 memory_full ();
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
558 #endif
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
559
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
560 /* 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
561 get infinite recursion trying to build the string. */
71967
3254b987edcb (buffer_memory_full, memory_full): Use xsignal. Remove loop.
Kim F. Storm <storm@cua.dk>
parents: 69876
diff changeset
562 xsignal (Qnil, Vmemory_signal_data);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
563 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
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
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
566 #ifdef XMALLOC_OVERRUN_CHECK
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
567
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
568 /* Check for overrun in malloc'ed buffers by wrapping a 16 byte header
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
569 and a 16 byte trailer around each block.
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
570
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
571 The header consists of 12 fixed bytes + a 4 byte integer contaning the
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
572 original block size, while the trailer consists of 16 fixed bytes.
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
573
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
574 The header is used to detect whether this block has been allocated
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
575 through these functions -- as it seems that some low-level libc
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
576 functions may bypass the malloc hooks.
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
577 */
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
578
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
579
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
580 #define XMALLOC_OVERRUN_CHECK_SIZE 16
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
581
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
582 static char xmalloc_overrun_check_header[XMALLOC_OVERRUN_CHECK_SIZE-4] =
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
583 { 0x9a, 0x9b, 0xae, 0xaf,
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
584 0xbf, 0xbe, 0xce, 0xcf,
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
585 0xea, 0xeb, 0xec, 0xed };
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
586
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
587 static char xmalloc_overrun_check_trailer[XMALLOC_OVERRUN_CHECK_SIZE] =
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
588 { 0xaa, 0xab, 0xac, 0xad,
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
589 0xba, 0xbb, 0xbc, 0xbd,
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
590 0xca, 0xcb, 0xcc, 0xcd,
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
591 0xda, 0xdb, 0xdc, 0xdd };
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
592
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
593 /* Macros to insert and extract the block size in the header. */
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
594
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
595 #define XMALLOC_PUT_SIZE(ptr, size) \
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
596 (ptr[-1] = (size & 0xff), \
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
597 ptr[-2] = ((size >> 8) & 0xff), \
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
598 ptr[-3] = ((size >> 16) & 0xff), \
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
599 ptr[-4] = ((size >> 24) & 0xff))
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
600
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
601 #define XMALLOC_GET_SIZE(ptr) \
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
602 (size_t)((unsigned)(ptr[-1]) | \
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
603 ((unsigned)(ptr[-2]) << 8) | \
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
604 ((unsigned)(ptr[-3]) << 16) | \
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
605 ((unsigned)(ptr[-4]) << 24))
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
606
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
607
59083
4295cf593352 Update comment for check_depth.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59082
diff changeset
608 /* The call depth in overrun_check functions. For example, this might happen:
4295cf593352 Update comment for check_depth.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59082
diff changeset
609 xmalloc()
4295cf593352 Update comment for check_depth.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59082
diff changeset
610 overrun_check_malloc()
4295cf593352 Update comment for check_depth.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59082
diff changeset
611 -> malloc -> (via hook)_-> emacs_blocked_malloc
4295cf593352 Update comment for check_depth.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59082
diff changeset
612 -> overrun_check_malloc
4295cf593352 Update comment for check_depth.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59082
diff changeset
613 call malloc (hooks are NULL, so real malloc is called).
4295cf593352 Update comment for check_depth.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59082
diff changeset
614 malloc returns 10000.
4295cf593352 Update comment for check_depth.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59082
diff changeset
615 add overhead, return 10016.
4295cf593352 Update comment for check_depth.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59082
diff changeset
616 <- (back in overrun_check_malloc)
59082
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
617 add overhead again, return 10032
59083
4295cf593352 Update comment for check_depth.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59082
diff changeset
618 xmalloc returns 10032.
59082
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
619
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
620 (time passes).
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
621
59083
4295cf593352 Update comment for check_depth.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59082
diff changeset
622 xfree(10032)
4295cf593352 Update comment for check_depth.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59082
diff changeset
623 overrun_check_free(10032)
4295cf593352 Update comment for check_depth.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59082
diff changeset
624 decrease overhed
4295cf593352 Update comment for check_depth.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59082
diff changeset
625 free(10016) <- crash, because 10000 is the original pointer. */
59082
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
626
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
627 static int check_depth;
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
628
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
629 /* Like malloc, but wraps allocated block with header and trailer. */
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
630
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
631 POINTER_TYPE *
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
632 overrun_check_malloc (size)
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
633 size_t size;
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
634 {
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
635 register unsigned char *val;
59082
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
636 size_t overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_SIZE*2 : 0;
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
637
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
638 val = (unsigned char *) malloc (size + overhead);
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
639 if (val && check_depth == 1)
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
640 {
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
641 bcopy (xmalloc_overrun_check_header, val, XMALLOC_OVERRUN_CHECK_SIZE - 4);
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
642 val += XMALLOC_OVERRUN_CHECK_SIZE;
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
643 XMALLOC_PUT_SIZE(val, size);
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
644 bcopy (xmalloc_overrun_check_trailer, val + size, XMALLOC_OVERRUN_CHECK_SIZE);
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
645 }
59082
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
646 --check_depth;
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
647 return (POINTER_TYPE *)val;
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
648 }
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
649
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
650
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
651 /* Like realloc, but checks old block for overrun, and wraps new block
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
652 with header and trailer. */
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
653
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
654 POINTER_TYPE *
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
655 overrun_check_realloc (block, size)
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
656 POINTER_TYPE *block;
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
657 size_t size;
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
658 {
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
659 register unsigned char *val = (unsigned char *)block;
59082
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
660 size_t overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_SIZE*2 : 0;
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
661
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
662 if (val
59082
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
663 && check_depth == 1
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
664 && bcmp (xmalloc_overrun_check_header,
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
665 val - XMALLOC_OVERRUN_CHECK_SIZE,
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
666 XMALLOC_OVERRUN_CHECK_SIZE - 4) == 0)
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
667 {
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
668 size_t osize = XMALLOC_GET_SIZE (val);
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
669 if (bcmp (xmalloc_overrun_check_trailer,
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
670 val + osize,
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
671 XMALLOC_OVERRUN_CHECK_SIZE))
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
672 abort ();
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
673 bzero (val + osize, XMALLOC_OVERRUN_CHECK_SIZE);
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
674 val -= XMALLOC_OVERRUN_CHECK_SIZE;
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
675 bzero (val, XMALLOC_OVERRUN_CHECK_SIZE);
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
676 }
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
677
59082
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
678 val = (unsigned char *) realloc ((POINTER_TYPE *)val, size + overhead);
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
679
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
680 if (val && check_depth == 1)
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
681 {
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
682 bcopy (xmalloc_overrun_check_header, val, XMALLOC_OVERRUN_CHECK_SIZE - 4);
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
683 val += XMALLOC_OVERRUN_CHECK_SIZE;
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
684 XMALLOC_PUT_SIZE(val, size);
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
685 bcopy (xmalloc_overrun_check_trailer, val + size, XMALLOC_OVERRUN_CHECK_SIZE);
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
686 }
59082
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
687 --check_depth;
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
688 return (POINTER_TYPE *)val;
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
689 }
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
690
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
691 /* Like free, but checks block for overrun. */
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
692
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
693 void
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
694 overrun_check_free (block)
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
695 POINTER_TYPE *block;
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
696 {
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
697 unsigned char *val = (unsigned char *)block;
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
698
59082
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
699 ++check_depth;
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
700 if (val
59082
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
701 && check_depth == 1
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
702 && bcmp (xmalloc_overrun_check_header,
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
703 val - XMALLOC_OVERRUN_CHECK_SIZE,
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
704 XMALLOC_OVERRUN_CHECK_SIZE - 4) == 0)
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
705 {
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
706 size_t osize = XMALLOC_GET_SIZE (val);
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
707 if (bcmp (xmalloc_overrun_check_trailer,
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
708 val + osize,
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
709 XMALLOC_OVERRUN_CHECK_SIZE))
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
710 abort ();
59400
eeb8b96d077d (mark_fringe_data): Declare extern.
Kim F. Storm <storm@cua.dk>
parents: 59359
diff changeset
711 #ifdef XMALLOC_CLEAR_FREE_MEMORY
eeb8b96d077d (mark_fringe_data): Declare extern.
Kim F. Storm <storm@cua.dk>
parents: 59359
diff changeset
712 val -= XMALLOC_OVERRUN_CHECK_SIZE;
eeb8b96d077d (mark_fringe_data): Declare extern.
Kim F. Storm <storm@cua.dk>
parents: 59359
diff changeset
713 memset (val, 0xff, osize + XMALLOC_OVERRUN_CHECK_SIZE*2);
eeb8b96d077d (mark_fringe_data): Declare extern.
Kim F. Storm <storm@cua.dk>
parents: 59359
diff changeset
714 #else
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
715 bzero (val + osize, XMALLOC_OVERRUN_CHECK_SIZE);
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
716 val -= XMALLOC_OVERRUN_CHECK_SIZE;
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
717 bzero (val, XMALLOC_OVERRUN_CHECK_SIZE);
59400
eeb8b96d077d (mark_fringe_data): Declare extern.
Kim F. Storm <storm@cua.dk>
parents: 59359
diff changeset
718 #endif
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
719 }
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
720
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
721 free (val);
59082
f487226310e0 * alloc.c (check_depth): New variable.
Jan Djärv <jan.h.d@swipnet.se>
parents: 59047
diff changeset
722 --check_depth;
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
723 }
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
724
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
725 #undef malloc
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
726 #undef realloc
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
727 #undef free
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
728 #define malloc overrun_check_malloc
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
729 #define realloc overrun_check_realloc
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
730 #define free overrun_check_free
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
731 #endif
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
732
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
733 #ifdef SYNC_INPUT
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
734 /* When using SYNC_INPUT, we don't call malloc from a signal handler, so
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
735 there's no need to block input around malloc. */
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
736 #define MALLOC_BLOCK_INPUT ((void)0)
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
737 #define MALLOC_UNBLOCK_INPUT ((void)0)
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
738 #else
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
739 #define MALLOC_BLOCK_INPUT BLOCK_INPUT
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
740 #define MALLOC_UNBLOCK_INPUT UNBLOCK_INPUT
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
741 #endif
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
742
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
743 /* Like malloc but check for no memory and block interrupt input.. */
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
744
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
745 POINTER_TYPE *
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
746 xmalloc (size)
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
747 size_t size;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
748 {
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
749 register POINTER_TYPE *val;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
750
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
751 MALLOC_BLOCK_INPUT;
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
752 val = (POINTER_TYPE *) malloc (size);
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
753 MALLOC_UNBLOCK_INPUT;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
754
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
755 if (!val && size)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
756 memory_full ();
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
757 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
758 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
759
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
760
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
761 /* 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
762
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
763 POINTER_TYPE *
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
764 xrealloc (block, size)
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
765 POINTER_TYPE *block;
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
766 size_t size;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
767 {
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
768 register POINTER_TYPE *val;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
769
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
770 MALLOC_BLOCK_INPUT;
590
1a6483439acc *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
771 /* We must call malloc explicitly when BLOCK is 0, since some
1a6483439acc *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
772 reallocs don't do this. */
1a6483439acc *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
773 if (! block)
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
774 val = (POINTER_TYPE *) malloc (size);
600
a8d78999e46d *** empty log message ***
Noah Friedman <friedman@splode.com>
parents: 590
diff changeset
775 else
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
776 val = (POINTER_TYPE *) realloc (block, size);
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
777 MALLOC_UNBLOCK_INPUT;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
778
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
779 if (!val && size) memory_full ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
780 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
781 }
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
782
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
783
52276
5623f26dff58 (lisp_align_malloc): Change type of `aligned'.
Dave Love <fx@gnu.org>
parents: 52256
diff changeset
784 /* Like free but block interrupt input. */
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
785
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
786 void
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
787 xfree (block)
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
788 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
789 {
95481
4390d64d3328 Make "xfree (NULL)" a no-op; remove useless if-before-xfree.
Jim Meyering <jim@meyering.net>
parents: 94993
diff changeset
790 if (!block)
4390d64d3328 Make "xfree (NULL)" a no-op; remove useless if-before-xfree.
Jim Meyering <jim@meyering.net>
parents: 94993
diff changeset
791 return;
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
792 MALLOC_BLOCK_INPUT;
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
793 free (block);
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
794 MALLOC_UNBLOCK_INPUT;
66530
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
795 /* We don't call refill_memory_reserve here
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
796 because that duplicates doing so in emacs_blocked_free
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
797 and the criterion should go there. */
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
798 }
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
799
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
800
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
801 /* Like strdup, but uses xmalloc. */
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
802
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
803 char *
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
804 xstrdup (s)
46459
0a9cbcbdbe45 (xstrdup, make_string, make_unibyte_string)
Ken Raeburn <raeburn@raeburn.org>
parents: 46418
diff changeset
805 const char *s;
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
806 {
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
807 size_t len = strlen (s) + 1;
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
808 char *p = (char *) xmalloc (len);
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
809 bcopy (s, p, len);
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
810 return p;
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
811 }
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
812
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
813
56187
e3720731abbb (safe_alloca_unwind): New function.
Kim F. Storm <storm@cua.dk>
parents: 55838
diff changeset
814 /* Unwind for SAFE_ALLOCA */
e3720731abbb (safe_alloca_unwind): New function.
Kim F. Storm <storm@cua.dk>
parents: 55838
diff changeset
815
e3720731abbb (safe_alloca_unwind): New function.
Kim F. Storm <storm@cua.dk>
parents: 55838
diff changeset
816 Lisp_Object
e3720731abbb (safe_alloca_unwind): New function.
Kim F. Storm <storm@cua.dk>
parents: 55838
diff changeset
817 safe_alloca_unwind (arg)
e3720731abbb (safe_alloca_unwind): New function.
Kim F. Storm <storm@cua.dk>
parents: 55838
diff changeset
818 Lisp_Object arg;
e3720731abbb (safe_alloca_unwind): New function.
Kim F. Storm <storm@cua.dk>
parents: 55838
diff changeset
819 {
56202
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
820 register struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
821
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
822 p->dogc = 0;
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
823 xfree (p->pointer);
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
824 p->pointer = 0;
56239
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
825 free_misc (arg);
56187
e3720731abbb (safe_alloca_unwind): New function.
Kim F. Storm <storm@cua.dk>
parents: 55838
diff changeset
826 return Qnil;
e3720731abbb (safe_alloca_unwind): New function.
Kim F. Storm <storm@cua.dk>
parents: 55838
diff changeset
827 }
e3720731abbb (safe_alloca_unwind): New function.
Kim F. Storm <storm@cua.dk>
parents: 55838
diff changeset
828
e3720731abbb (safe_alloca_unwind): New function.
Kim F. Storm <storm@cua.dk>
parents: 55838
diff changeset
829
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
830 /* 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
831 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
832 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
833
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
834 #ifndef USE_LSB_TAG
50468
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
835 static void *lisp_malloc_loser;
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
836 #endif
50468
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
837
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
838 static POINTER_TYPE *
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
839 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
840 size_t nbytes;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
841 enum mem_type type;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
842 {
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
843 register void *val;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
844
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
845 MALLOC_BLOCK_INPUT;
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
846
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
847 #ifdef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
848 allocated_mem_type = type;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
849 #endif
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
850
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
851 val = (void *) malloc (nbytes);
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
852
53650
5558449888ec (lisp_malloc, lisp_align_malloc) [USE_LSB_TAG]:
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53582
diff changeset
853 #ifndef USE_LSB_TAG
50468
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
854 /* If the memory just allocated cannot be addressed thru a Lisp
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
855 object's pointer, and it needs to be,
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
856 that's equivalent to running out of memory. */
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
857 if (val && type != MEM_TYPE_NON_LISP)
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
858 {
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
859 Lisp_Object tem;
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
860 XSETCONS (tem, (char *) val + nbytes - 1);
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
861 if ((char *) XCONS (tem) != (char *) val + nbytes - 1)
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
862 {
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
863 lisp_malloc_loser = val;
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
864 free (val);
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
865 val = 0;
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
866 }
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
867 }
53650
5558449888ec (lisp_malloc, lisp_align_malloc) [USE_LSB_TAG]:
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53582
diff changeset
868 #endif
50468
16fdb9f87d89 (VALIDATE_LISP_STORAGE): Macro deleted. All calls deleted.
Richard M. Stallman <rms@gnu.org>
parents: 50274
diff changeset
869
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
870 #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
871 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
872 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
873 #endif
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
874
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
875 MALLOC_UNBLOCK_INPUT;
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
876 if (!val && nbytes)
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
877 memory_full ();
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
878 return val;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
879 }
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
880
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
881 /* 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
882 call to lisp_malloc. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
883
30784
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
884 static void
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
885 lisp_free (block)
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
886 POINTER_TYPE *block;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
887 {
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
888 MALLOC_BLOCK_INPUT;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
889 free (block);
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
890 #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
891 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
892 #endif
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
893 MALLOC_UNBLOCK_INPUT;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
894 }
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
895
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
896 /* Allocation of aligned blocks of memory to store Lisp data. */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
897 /* The entry point is lisp_align_malloc which returns blocks of at most */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
898 /* BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
899
69348
2c8e608f28e7 (USE_POSIX_MEMALIGN): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 68974
diff changeset
900 /* Use posix_memalloc if the system has it and we're using the system's
2c8e608f28e7 (USE_POSIX_MEMALIGN): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 68974
diff changeset
901 malloc (because our gmalloc.c routines don't have posix_memalign although
2c8e608f28e7 (USE_POSIX_MEMALIGN): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 68974
diff changeset
902 its memalloc could be used). */
69355
a685fca1ccb6 (USE_POSIX_MEMALIGN): Fix last change.
Kim F. Storm <storm@cua.dk>
parents: 69348
diff changeset
903 #if defined (HAVE_POSIX_MEMALIGN) && defined (SYSTEM_MALLOC)
a685fca1ccb6 (USE_POSIX_MEMALIGN): Fix last change.
Kim F. Storm <storm@cua.dk>
parents: 69348
diff changeset
904 #define USE_POSIX_MEMALIGN 1
a685fca1ccb6 (USE_POSIX_MEMALIGN): Fix last change.
Kim F. Storm <storm@cua.dk>
parents: 69348
diff changeset
905 #endif
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
906
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
907 /* BLOCK_ALIGN has to be a power of 2. */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
908 #define BLOCK_ALIGN (1 << 10)
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
909
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
910 /* Padding to leave at the end of a malloc'd block. This is to give
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
911 malloc a chance to minimize the amount of memory wasted to alignment.
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
912 It should be tuned to the particular malloc library used.
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
913 On glibc-2.3.2, malloc never tries to align, so a padding of 0 is best.
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
914 posix_memalign on the other hand would ideally prefer a value of 4
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
915 because otherwise, there's 1020 bytes wasted between each ablocks.
60143
84ff5b7a4139 (BLOCK_BYTES): Harmless typo.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59657
diff changeset
916 In Emacs, testing shows that those 1020 can most of the time be
84ff5b7a4139 (BLOCK_BYTES): Harmless typo.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59657
diff changeset
917 efficiently used by malloc to place other objects, so a value of 0 can
84ff5b7a4139 (BLOCK_BYTES): Harmless typo.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59657
diff changeset
918 still preferable unless you have a lot of aligned blocks and virtually
84ff5b7a4139 (BLOCK_BYTES): Harmless typo.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59657
diff changeset
919 nothing else. */
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
920 #define BLOCK_PADDING 0
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
921 #define BLOCK_BYTES \
60143
84ff5b7a4139 (BLOCK_BYTES): Harmless typo.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59657
diff changeset
922 (BLOCK_ALIGN - sizeof (struct ablock *) - BLOCK_PADDING)
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
923
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
924 /* Internal data structures and constants. */
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
925
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
926 #define ABLOCKS_SIZE 16
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
927
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
928 /* An aligned block of memory. */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
929 struct ablock
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
930 {
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
931 union
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
932 {
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
933 char payload[BLOCK_BYTES];
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
934 struct ablock *next_free;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
935 } x;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
936 /* `abase' is the aligned base of the ablocks. */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
937 /* It is overloaded to hold the virtual `busy' field that counts
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
938 the number of used ablock in the parent ablocks.
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
939 The first ablock has the `busy' field, the others have the `abase'
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
940 field. To tell the difference, we assume that pointers will have
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
941 integer values larger than 2 * ABLOCKS_SIZE. The lowest bit of `busy'
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
942 is used to tell whether the real base of the parent ablocks is `abase'
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
943 (if not, the word before the first ablock holds a pointer to the
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
944 real base). */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
945 struct ablocks *abase;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
946 /* The padding of all but the last ablock is unused. The padding of
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
947 the last ablock in an ablocks is not allocated. */
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
948 #if BLOCK_PADDING
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
949 char padding[BLOCK_PADDING];
51758
ff38ea4b40ed (struct ablock): Only include padding when there is some.
Jason Rumney <jasonr@gnu.org>
parents: 51723
diff changeset
950 #endif
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
951 };
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
952
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
953 /* A bunch of consecutive aligned blocks. */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
954 struct ablocks
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
955 {
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
956 struct ablock blocks[ABLOCKS_SIZE];
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
957 };
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
958
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
959 /* Size of the block requested from malloc or memalign. */
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
960 #define ABLOCKS_BYTES (sizeof (struct ablocks) - BLOCK_PADDING)
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
961
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
962 #define ABLOCK_ABASE(block) \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
963 (((unsigned long) (block)->abase) <= (1 + 2 * ABLOCKS_SIZE) \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
964 ? (struct ablocks *)(block) \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
965 : (block)->abase)
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
966
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
967 /* Virtual `busy' field. */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
968 #define ABLOCKS_BUSY(abase) ((abase)->blocks[0].abase)
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
969
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
970 /* Pointer to the (not necessarily aligned) malloc block. */
69348
2c8e608f28e7 (USE_POSIX_MEMALIGN): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 68974
diff changeset
971 #ifdef USE_POSIX_MEMALIGN
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
972 #define ABLOCKS_BASE(abase) (abase)
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
973 #else
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
974 #define ABLOCKS_BASE(abase) \
52453
62fcd311bb98 Use long instead of int when casting ABLOCKS_BUSY to
Andreas Schwab <schwab@suse.de>
parents: 52401
diff changeset
975 (1 & (long) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1])
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
976 #endif
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
977
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
978 /* The list of free ablock. */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
979 static struct ablock *free_ablock;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
980
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
981 /* Allocate an aligned block of nbytes.
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
982 Alignment is on a multiple of BLOCK_ALIGN and `nbytes' has to be
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
983 smaller or equal to BLOCK_BYTES. */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
984 static POINTER_TYPE *
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
985 lisp_align_malloc (nbytes, type)
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
986 size_t nbytes;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
987 enum mem_type type;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
988 {
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
989 void *base, *val;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
990 struct ablocks *abase;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
991
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
992 eassert (nbytes <= BLOCK_BYTES);
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
993
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
994 MALLOC_BLOCK_INPUT;
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
995
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
996 #ifdef GC_MALLOC_CHECK
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
997 allocated_mem_type = type;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
998 #endif
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
999
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1000 if (!free_ablock)
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1001 {
52276
5623f26dff58 (lisp_align_malloc): Change type of `aligned'.
Dave Love <fx@gnu.org>
parents: 52256
diff changeset
1002 int i;
5623f26dff58 (lisp_align_malloc): Change type of `aligned'.
Dave Love <fx@gnu.org>
parents: 52256
diff changeset
1003 EMACS_INT aligned; /* int gets warning casting to 64-bit pointer. */
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1004
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1005 #ifdef DOUG_LEA_MALLOC
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1006 /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1007 because mapped region contents are not preserved in
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1008 a dumped Emacs. */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1009 mallopt (M_MMAP_MAX, 0);
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1010 #endif
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1011
69348
2c8e608f28e7 (USE_POSIX_MEMALIGN): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 68974
diff changeset
1012 #ifdef USE_POSIX_MEMALIGN
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
1013 {
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
1014 int err = posix_memalign (&base, BLOCK_ALIGN, ABLOCKS_BYTES);
55836
a05a653f63af (lisp_align_malloc): Check for base == 0 regardless of HAVE_POSIX_MEMALIGN.
Richard M. Stallman <rms@gnu.org>
parents: 55816
diff changeset
1015 if (err)
a05a653f63af (lisp_align_malloc): Check for base == 0 regardless of HAVE_POSIX_MEMALIGN.
Richard M. Stallman <rms@gnu.org>
parents: 55816
diff changeset
1016 base = NULL;
a05a653f63af (lisp_align_malloc): Check for base == 0 regardless of HAVE_POSIX_MEMALIGN.
Richard M. Stallman <rms@gnu.org>
parents: 55816
diff changeset
1017 abase = base;
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
1018 }
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
1019 #else
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1020 base = malloc (ABLOCKS_BYTES);
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1021 abase = ALIGN (base, BLOCK_ALIGN);
55836
a05a653f63af (lisp_align_malloc): Check for base == 0 regardless of HAVE_POSIX_MEMALIGN.
Richard M. Stallman <rms@gnu.org>
parents: 55816
diff changeset
1022 #endif
a05a653f63af (lisp_align_malloc): Check for base == 0 regardless of HAVE_POSIX_MEMALIGN.
Richard M. Stallman <rms@gnu.org>
parents: 55816
diff changeset
1023
52837
1bbf3f566879 (lisp_align_malloc): If BASE is 0, call memory_full.
Richard M. Stallman <rms@gnu.org>
parents: 52547
diff changeset
1024 if (base == 0)
1bbf3f566879 (lisp_align_malloc): If BASE is 0, call memory_full.
Richard M. Stallman <rms@gnu.org>
parents: 52547
diff changeset
1025 {
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
1026 MALLOC_UNBLOCK_INPUT;
52837
1bbf3f566879 (lisp_align_malloc): If BASE is 0, call memory_full.
Richard M. Stallman <rms@gnu.org>
parents: 52547
diff changeset
1027 memory_full ();
1bbf3f566879 (lisp_align_malloc): If BASE is 0, call memory_full.
Richard M. Stallman <rms@gnu.org>
parents: 52547
diff changeset
1028 }
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1029
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1030 aligned = (base == abase);
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1031 if (!aligned)
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1032 ((void**)abase)[-1] = base;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1033
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1034 #ifdef DOUG_LEA_MALLOC
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1035 /* Back to a reasonable maximum of mmap'ed areas. */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1036 mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1037 #endif
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1038
53650
5558449888ec (lisp_malloc, lisp_align_malloc) [USE_LSB_TAG]:
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53582
diff changeset
1039 #ifndef USE_LSB_TAG
52256
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1040 /* If the memory just allocated cannot be addressed thru a Lisp
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1041 object's pointer, and it needs to be, that's equivalent to
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1042 running out of memory. */
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1043 if (type != MEM_TYPE_NON_LISP)
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1044 {
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1045 Lisp_Object tem;
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1046 char *end = (char *) base + ABLOCKS_BYTES - 1;
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1047 XSETCONS (tem, end);
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1048 if ((char *) XCONS (tem) != end)
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1049 {
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1050 lisp_malloc_loser = base;
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1051 free (base);
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
1052 MALLOC_UNBLOCK_INPUT;
52256
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1053 memory_full ();
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1054 }
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1055 }
53650
5558449888ec (lisp_malloc, lisp_align_malloc) [USE_LSB_TAG]:
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53582
diff changeset
1056 #endif
52256
36e112575ca8 (lisp_align_malloc): Check for memory full when
Gerd Moellmann <gerd@gnu.org>
parents: 52166
diff changeset
1057
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1058 /* Initialize the blocks and put them on the free list.
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1059 Is `base' was not properly aligned, we can't use the last block. */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1060 for (i = 0; i < (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1); i++)
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1061 {
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1062 abase->blocks[i].abase = abase;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1063 abase->blocks[i].x.next_free = free_ablock;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1064 free_ablock = &abase->blocks[i];
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1065 }
52453
62fcd311bb98 Use long instead of int when casting ABLOCKS_BUSY to
Andreas Schwab <schwab@suse.de>
parents: 52401
diff changeset
1066 ABLOCKS_BUSY (abase) = (struct ablocks *) (long) aligned;
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1067
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
1068 eassert (0 == ((EMACS_UINT)abase) % BLOCK_ALIGN);
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1069 eassert (ABLOCK_ABASE (&abase->blocks[3]) == abase); /* 3 is arbitrary */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1070 eassert (ABLOCK_ABASE (&abase->blocks[0]) == abase);
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1071 eassert (ABLOCKS_BASE (abase) == base);
52453
62fcd311bb98 Use long instead of int when casting ABLOCKS_BUSY to
Andreas Schwab <schwab@suse.de>
parents: 52401
diff changeset
1072 eassert (aligned == (long) ABLOCKS_BUSY (abase));
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1073 }
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1074
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1075 abase = ABLOCK_ABASE (free_ablock);
52453
62fcd311bb98 Use long instead of int when casting ABLOCKS_BUSY to
Andreas Schwab <schwab@suse.de>
parents: 52401
diff changeset
1076 ABLOCKS_BUSY (abase) = (struct ablocks *) (2 + (long) ABLOCKS_BUSY (abase));
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1077 val = free_ablock;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1078 free_ablock = free_ablock->x.next_free;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1079
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1080 #if GC_MARK_STACK && !defined GC_MALLOC_CHECK
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1081 if (val && type != MEM_TYPE_NON_LISP)
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1082 mem_insert (val, (char *) val + nbytes, type);
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1083 #endif
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1084
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
1085 MALLOC_UNBLOCK_INPUT;
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1086 if (!val && nbytes)
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1087 memory_full ();
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1088
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1089 eassert (0 == ((EMACS_UINT)val) % BLOCK_ALIGN);
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1090 return val;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1091 }
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1092
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1093 static void
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1094 lisp_align_free (block)
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1095 POINTER_TYPE *block;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1096 {
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1097 struct ablock *ablock = block;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1098 struct ablocks *abase = ABLOCK_ABASE (ablock);
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1099
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
1100 MALLOC_BLOCK_INPUT;
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1101 #if GC_MARK_STACK && !defined GC_MALLOC_CHECK
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1102 mem_delete (mem_find (block));
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1103 #endif
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1104 /* Put on free list. */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1105 ablock->x.next_free = free_ablock;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1106 free_ablock = ablock;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1107 /* Update busy count. */
52453
62fcd311bb98 Use long instead of int when casting ABLOCKS_BUSY to
Andreas Schwab <schwab@suse.de>
parents: 52401
diff changeset
1108 ABLOCKS_BUSY (abase) = (struct ablocks *) (-2 + (long) ABLOCKS_BUSY (abase));
55634
d3542bbadad7 (mark_object): Ignore Lisp_Misc_Free objects.
Kim F. Storm <storm@cua.dk>
parents: 55159
diff changeset
1109
52453
62fcd311bb98 Use long instead of int when casting ABLOCKS_BUSY to
Andreas Schwab <schwab@suse.de>
parents: 52401
diff changeset
1110 if (2 > (long) ABLOCKS_BUSY (abase))
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1111 { /* All the blocks are free. */
52453
62fcd311bb98 Use long instead of int when casting ABLOCKS_BUSY to
Andreas Schwab <schwab@suse.de>
parents: 52401
diff changeset
1112 int i = 0, aligned = (long) ABLOCKS_BUSY (abase);
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1113 struct ablock **tem = &free_ablock;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1114 struct ablock *atop = &abase->blocks[aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1];
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1115
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1116 while (*tem)
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1117 {
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1118 if (*tem >= (struct ablock *) abase && *tem < atop)
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1119 {
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1120 i++;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1121 *tem = (*tem)->x.next_free;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1122 }
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1123 else
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1124 tem = &(*tem)->x.next_free;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1125 }
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1126 eassert ((aligned & 1) == aligned);
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1127 eassert (i == (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1));
69348
2c8e608f28e7 (USE_POSIX_MEMALIGN): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 68974
diff changeset
1128 #ifdef USE_POSIX_MEMALIGN
68350
263a4edafafa (lisp_align_free): Add an assertion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 67494
diff changeset
1129 eassert ((unsigned long)ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0);
263a4edafafa (lisp_align_free): Add an assertion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 67494
diff changeset
1130 #endif
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1131 free (ABLOCKS_BASE (abase));
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1132 }
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
1133 MALLOC_UNBLOCK_INPUT;
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
1134 }
51683
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
1135
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
1136 /* Return a new buffer structure allocated from the heap with
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
1137 a call to lisp_malloc. */
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
1138
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
1139 struct buffer *
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
1140 allocate_buffer ()
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
1141 {
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
1142 struct buffer *b
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
1143 = (struct buffer *) lisp_malloc (sizeof (struct buffer),
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
1144 MEM_TYPE_BUFFER);
85328
d0d527210b0c * lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85023
diff changeset
1145 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
d0d527210b0c * lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85023
diff changeset
1146 XSETPVECTYPE (b, PVEC_BUFFER);
51683
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
1147 return b;
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
1148 }
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
1149
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1150
59359
1678d14c4109 (refill_memory_reserve): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59314
diff changeset
1151 #ifndef SYSTEM_MALLOC
1678d14c4109 (refill_memory_reserve): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59314
diff changeset
1152
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1153 /* 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
1154
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1155 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
1156 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
1157 elsewhere in the code should be inside a BLOCK_INPUT/UNBLOCK_INPUT
59359
1678d14c4109 (refill_memory_reserve): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59314
diff changeset
1158 pair; unfortunately, we have no idea what C library functions
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1159 might call malloc, so we can't really protect them unless you're
49529
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
1160 using GNU malloc. Fortunately, most of the major operating systems
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
1161 can use GNU malloc. */
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1162
59359
1678d14c4109 (refill_memory_reserve): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59314
diff changeset
1163 #ifndef SYNC_INPUT
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
1164 /* When using SYNC_INPUT, we don't call malloc from a signal handler, so
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
1165 there's no need to block input around malloc. */
59359
1678d14c4109 (refill_memory_reserve): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59314
diff changeset
1166
30914
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
1167 #ifndef DOUG_LEA_MALLOC
65764
375ab086d366 * image.c (slurp_file, xbm_read_bitmap_data): Cast to the correct
Dan Nicolaescu <dann@ics.uci.edu>
parents: 64611
diff changeset
1168 extern void * (*__malloc_hook) P_ ((size_t, const void *));
375ab086d366 * image.c (slurp_file, xbm_read_bitmap_data): Cast to the correct
Dan Nicolaescu <dann@ics.uci.edu>
parents: 64611
diff changeset
1169 extern void * (*__realloc_hook) P_ ((void *, size_t, const void *));
375ab086d366 * image.c (slurp_file, xbm_read_bitmap_data): Cast to the correct
Dan Nicolaescu <dann@ics.uci.edu>
parents: 64611
diff changeset
1170 extern void (*__free_hook) P_ ((void *, const void *));
30914
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
1171 /* 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
1172 #endif /* DOUG_LEA_MALLOC */
65764
375ab086d366 * image.c (slurp_file, xbm_read_bitmap_data): Cast to the correct
Dan Nicolaescu <dann@ics.uci.edu>
parents: 64611
diff changeset
1173 static void * (*old_malloc_hook) P_ ((size_t, const void *));
375ab086d366 * image.c (slurp_file, xbm_read_bitmap_data): Cast to the correct
Dan Nicolaescu <dann@ics.uci.edu>
parents: 64611
diff changeset
1174 static void * (*old_realloc_hook) P_ ((void *, size_t, const void*));
375ab086d366 * image.c (slurp_file, xbm_read_bitmap_data): Cast to the correct
Dan Nicolaescu <dann@ics.uci.edu>
parents: 64611
diff changeset
1175 static void (*old_free_hook) P_ ((void*, const void*));
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1176
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
1177 /* 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
1178
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1179 static void
65764
375ab086d366 * image.c (slurp_file, xbm_read_bitmap_data): Cast to the correct
Dan Nicolaescu <dann@ics.uci.edu>
parents: 64611
diff changeset
1180 emacs_blocked_free (ptr, ptr2)
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1181 void *ptr;
65764
375ab086d366 * image.c (slurp_file, xbm_read_bitmap_data): Cast to the correct
Dan Nicolaescu <dann@ics.uci.edu>
parents: 64611
diff changeset
1182 const void *ptr2;
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1183 {
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1184 BLOCK_INPUT_ALLOC;
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1185
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1186 #ifdef GC_MALLOC_CHECK
32776
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
1187 if (ptr)
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
1188 {
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
1189 struct mem_node *m;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1190
32776
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
1191 m = mem_find (ptr);
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
1192 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
1193 {
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
1194 fprintf (stderr,
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
1195 "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
1196 abort ();
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
1197 }
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
1198 else
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
1199 {
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
1200 /* 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
1201 mem_delete (m);
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
1202 }
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
1203 }
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1204 #endif /* GC_MALLOC_CHECK */
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1205
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1206 __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
1207 free (ptr);
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1208
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
1209 /* 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
1210 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
1211 try to set aside another reserve in case we run out once more. */
66530
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
1212 if (! NILP (Vmemory_full)
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
1213 /* 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
1214 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
1215 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
1216 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
1217 && (bytes_used_when_full
66547
9373f926904a (BYTES_USED): Use uordblks, not arena.
Richard M. Stallman <rms@gnu.org>
parents: 66541
diff changeset
1218 > ((bytes_used_when_reconsidered = BYTES_USED)
66541
60d77f0435af * alloc.c (emacs_blocked_free): Fix typo.
Chong Yidong <cyd@stupidchicken.com>
parents: 66530
diff changeset
1219 + max (malloc_hysteresis, 4) * SPARE_MEMORY)))
66530
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
1220 refill_memory_reserve ();
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
1221
2507
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
1222 __free_hook = emacs_blocked_free;
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1223 UNBLOCK_INPUT_ALLOC;
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1224 }
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1225
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1226
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
1227 /* 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
1228
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1229 static void *
65764
375ab086d366 * image.c (slurp_file, xbm_read_bitmap_data): Cast to the correct
Dan Nicolaescu <dann@ics.uci.edu>
parents: 64611
diff changeset
1230 emacs_blocked_malloc (size, ptr)
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
1231 size_t size;
65764
375ab086d366 * image.c (slurp_file, xbm_read_bitmap_data): Cast to the correct
Dan Nicolaescu <dann@ics.uci.edu>
parents: 64611
diff changeset
1232 const void *ptr;
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1233 {
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1234 void *value;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1235
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1236 BLOCK_INPUT_ALLOC;
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1237 __malloc_hook = old_malloc_hook;
17831
9238a2254a23 (BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents: 17348
diff changeset
1238 #ifdef DOUG_LEA_MALLOC
83543
6b25ef5cc276 Fix obvious runtime errors after merge.
Karoly Lorentey <lorentey@elte.hu>
parents: 83541
diff changeset
1239 /* Segfaults on my system. --lorentey */
6b25ef5cc276 Fix obvious runtime errors after merge.
Karoly Lorentey <lorentey@elte.hu>
parents: 83541
diff changeset
1240 /* 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
1241 #else
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
1242 __malloc_extra_blocks = malloc_hysteresis;
17831
9238a2254a23 (BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents: 17348
diff changeset
1243 #endif
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1244
3581
152fd924c7bb * alloc.c (emacs_blocked_malloc, emacs_blocked_realloc): Cast the
Jim Blandy <jimb@redhat.com>
parents: 3536
diff changeset
1245 value = (void *) malloc (size);
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1246
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1247 #ifdef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1248 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1249 struct mem_node *m = mem_find (value);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1250 if (m != MEM_NIL)
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1251 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1252 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
1253 value);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1254 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
1255 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
1256 m->type);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1257 abort ();
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1258 }
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1259
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1260 if (!dont_register_blocks)
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1261 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1262 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
1263 allocated_mem_type = MEM_TYPE_NON_LISP;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1264 }
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1265 }
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1266 #endif /* GC_MALLOC_CHECK */
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1267
2507
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
1268 __malloc_hook = emacs_blocked_malloc;
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1269 UNBLOCK_INPUT_ALLOC;
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1270
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1271 /* 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
1272 return value;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1273 }
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1274
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1275
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1276 /* 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
1277
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1278 static void *
65764
375ab086d366 * image.c (slurp_file, xbm_read_bitmap_data): Cast to the correct
Dan Nicolaescu <dann@ics.uci.edu>
parents: 64611
diff changeset
1279 emacs_blocked_realloc (ptr, size, ptr2)
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1280 void *ptr;
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
1281 size_t size;
65764
375ab086d366 * image.c (slurp_file, xbm_read_bitmap_data): Cast to the correct
Dan Nicolaescu <dann@ics.uci.edu>
parents: 64611
diff changeset
1282 const void *ptr2;
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1283 {
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1284 void *value;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1285
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1286 BLOCK_INPUT_ALLOC;
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1287 __realloc_hook = old_realloc_hook;
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1288
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1289 #ifdef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1290 if (ptr)
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1291 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1292 struct mem_node *m = mem_find (ptr);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1293 if (m == MEM_NIL || m->start != ptr)
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1294 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1295 fprintf (stderr,
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1296 "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
1297 ptr);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1298 abort ();
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1299 }
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1300
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1301 mem_delete (m);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1302 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1303
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1304 /* fprintf (stderr, "%p -> realloc\n", ptr); */
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1305
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1306 /* Prevent malloc from registering blocks. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1307 dont_register_blocks = 1;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1308 #endif /* GC_MALLOC_CHECK */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1309
3581
152fd924c7bb * alloc.c (emacs_blocked_malloc, emacs_blocked_realloc): Cast the
Jim Blandy <jimb@redhat.com>
parents: 3536
diff changeset
1310 value = (void *) realloc (ptr, size);
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1311
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1312 #ifdef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1313 dont_register_blocks = 0;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1314
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1315 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1316 struct mem_node *m = mem_find (value);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1317 if (m != MEM_NIL)
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1318 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1319 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
1320 abort ();
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1321 }
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1322
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1323 /* 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
1324 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
1325 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1326
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1327 /* fprintf (stderr, "%p <- realloc\n", value); */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
1328 #endif /* GC_MALLOC_CHECK */
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1329
2507
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
1330 __realloc_hook = emacs_blocked_realloc;
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1331 UNBLOCK_INPUT_ALLOC;
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1332
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1333 return value;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1334 }
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1335
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1336
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1337 #ifdef HAVE_GTK_AND_PTHREAD
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1338 /* Called from Fdump_emacs so that when the dumped Emacs starts, it has a
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1339 normal malloc. Some thread implementations need this as they call
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1340 malloc before main. The pthread_self call in BLOCK_INPUT_ALLOC then
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1341 calls malloc because it is the first call, and we have an endless loop. */
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1342
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1343 void
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1344 reset_malloc_hooks ()
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1345 {
78811
6ebdc9c66c94 (reset_malloc_hooks): Set the hooks to the previous
Andreas Schwab <schwab@suse.de>
parents: 78593
diff changeset
1346 __free_hook = old_free_hook;
6ebdc9c66c94 (reset_malloc_hooks): Set the hooks to the previous
Andreas Schwab <schwab@suse.de>
parents: 78593
diff changeset
1347 __malloc_hook = old_malloc_hook;
6ebdc9c66c94 (reset_malloc_hooks): Set the hooks to the previous
Andreas Schwab <schwab@suse.de>
parents: 78593
diff changeset
1348 __realloc_hook = old_realloc_hook;
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1349 }
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1350 #endif /* HAVE_GTK_AND_PTHREAD */
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1351
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1352
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1353 /* 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
1354
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1355 void
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1356 uninterrupt_malloc ()
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
1357 {
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1358 #ifdef HAVE_GTK_AND_PTHREAD
80502
07f3d63ad3d3 [!SYSTEM_MALLOC && !SYNC_INPUT] (uninterrupt_malloc)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 79759
diff changeset
1359 #ifdef DOUG_LEA_MALLOC
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1360 pthread_mutexattr_t attr;
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1361
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1362 /* GLIBC has a faster way to do this, but lets keep it portable.
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1363 This is according to the Single UNIX Specification. */
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1364 pthread_mutexattr_init (&attr);
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1365 pthread_mutexattr_settype (&attr, PTHREAD_MUTEX_RECURSIVE);
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1366 pthread_mutex_init (&alloc_mutex, &attr);
80502
07f3d63ad3d3 [!SYSTEM_MALLOC && !SYNC_INPUT] (uninterrupt_malloc)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 79759
diff changeset
1367 #else /* !DOUG_LEA_MALLOC */
107984
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
1368 /* Some systems such as Solaris 2.6 don't have a recursive mutex,
80502
07f3d63ad3d3 [!SYSTEM_MALLOC && !SYNC_INPUT] (uninterrupt_malloc)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 79759
diff changeset
1369 and the bundled gmalloc.c doesn't require it. */
07f3d63ad3d3 [!SYSTEM_MALLOC && !SYNC_INPUT] (uninterrupt_malloc)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 79759
diff changeset
1370 pthread_mutex_init (&alloc_mutex, NULL);
07f3d63ad3d3 [!SYSTEM_MALLOC && !SYNC_INPUT] (uninterrupt_malloc)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 79759
diff changeset
1371 #endif /* !DOUG_LEA_MALLOC */
58818
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1372 #endif /* HAVE_GTK_AND_PTHREAD */
f8cddae7d959 * gtkutil.c: Include signal.h and syssignal.h.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58707
diff changeset
1373
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1374 if (__free_hook != emacs_blocked_free)
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1375 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
1376 __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
1377
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1378 if (__malloc_hook != emacs_blocked_malloc)
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1379 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
1380 __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
1381
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1382 if (__realloc_hook != emacs_blocked_realloc)
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1383 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
1384 __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
1385 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1386
59359
1678d14c4109 (refill_memory_reserve): Move.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59314
diff changeset
1387 #endif /* not SYNC_INPUT */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1388 #endif /* not SYSTEM_MALLOC */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1389
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1390
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1391
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1392 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1393 Interval Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1394 ***********************************************************************/
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
1395
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1396 /* 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
1397 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
1398
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1399 #define INTERVAL_BLOCK_SIZE \
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1400 ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval))
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1401
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1402 /* 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
1403 structure. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1404
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1405 struct interval_block
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1406 {
53582
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
1407 /* Place `intervals' first, to preserve alignment. */
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
1408 struct interval intervals[INTERVAL_BLOCK_SIZE];
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1409 struct interval_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1410 };
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1411
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1412 /* 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
1413 blocks. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1414
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
1415 static 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
1416
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1417 /* 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
1418 structure. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1419
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1420 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
1421
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1422 /* 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
1423
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1424 static int total_free_intervals, total_intervals;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1425
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1426 /* List of free intervals. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1427
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1428 INTERVAL interval_free_list;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1429
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1430 /* 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
1431
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
1432 static int n_interval_blocks;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1433
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1434
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1435 /* Initialize interval allocation. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1436
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1437 static void
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1438 init_intervals ()
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1439 {
52473
a3fd06a8c844 (init_intervals, init_symbol, init_marker): Don't preallocate anything.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52453
diff changeset
1440 interval_block = NULL;
a3fd06a8c844 (init_intervals, init_symbol, init_marker): Don't preallocate anything.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52453
diff changeset
1441 interval_block_index = INTERVAL_BLOCK_SIZE;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1442 interval_free_list = 0;
52473
a3fd06a8c844 (init_intervals, init_symbol, init_marker): Don't preallocate anything.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52453
diff changeset
1443 n_interval_blocks = 0;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1444 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1445
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1446
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1447 /* Return a new interval. */
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1448
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1449 INTERVAL
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1450 make_interval ()
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1451 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1452 INTERVAL val;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1453
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
1454 /* eassert (!handling_signal); */
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
1455
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
1456 MALLOC_BLOCK_INPUT;
68350
263a4edafafa (lisp_align_free): Add an assertion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 67494
diff changeset
1457
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1458 if (interval_free_list)
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1459 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1460 val = interval_free_list;
28269
fd13be8ae190 Changes towards better type safety regarding intervals, primarily
Ken Raeburn <raeburn@raeburn.org>
parents: 28220
diff changeset
1461 interval_free_list = INTERVAL_PARENT (interval_free_list);
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1462 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1463 else
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1464 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1465 if (interval_block_index == INTERVAL_BLOCK_SIZE)
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1466 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
1467 register struct interval_block *newi;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1468
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1469 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
1470 MEM_TYPE_NON_LISP);
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1471
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1472 newi->next = interval_block;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1473 interval_block = newi;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1474 interval_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1475 n_interval_blocks++;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1476 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1477 val = &interval_block->intervals[interval_block_index++];
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1478 }
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
1479
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
1480 MALLOC_UNBLOCK_INPUT;
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
1481
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1482 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
1483 intervals_consed++;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1484 RESET_INTERVAL (val);
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
1485 val->gcmarkbit = 0;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1486 return val;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1487 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1488
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1489
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1490 /* Mark Lisp objects in interval I. */
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1491
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1492 static void
1957
54c8c66cd9ac (mark_interval): Add ignored arg.
Richard M. Stallman <rms@gnu.org>
parents: 1939
diff changeset
1493 mark_interval (i, dummy)
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1494 register INTERVAL i;
1957
54c8c66cd9ac (mark_interval): Add ignored arg.
Richard M. Stallman <rms@gnu.org>
parents: 1939
diff changeset
1495 Lisp_Object dummy;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1496 {
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
1497 eassert (!i->gcmarkbit); /* Intervals are never shared. */
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
1498 i->gcmarkbit = 1;
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
1499 mark_object (i->plist);
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1500 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1501
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1502
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1503 /* 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
1504 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
1505
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1506 static void
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1507 mark_interval_tree (tree)
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1508 register INTERVAL tree;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1509 {
4139
0b32ee899a3a Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents: 4087
diff changeset
1510 /* 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
1511 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
1512 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
1513
39859
36068b62b4c1 (mark_interval_tree): Use traverse_intervals_noorder.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39682
diff changeset
1514 traverse_intervals_noorder (tree, mark_interval, Qnil);
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1515 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1516
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1517
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1518 /* 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
1519
4139
0b32ee899a3a Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents: 4087
diff changeset
1520 #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
1521 do { \
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
1522 if (!NULL_INTERVAL_P (i) && !i->gcmarkbit) \
4139
0b32ee899a3a Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents: 4087
diff changeset
1523 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
1524 } while (0)
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1525
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1526
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1527 #define UNMARK_BALANCE_INTERVALS(i) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1528 do { \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1529 if (! NULL_INTERVAL_P (i)) \
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
1530 (i) = balance_intervals (i); \
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1531 } while (0)
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1532
28469
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
1533
96602
0e3e875ffade * lisp.h:
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96545
diff changeset
1534 /* Number support. If USE_LISP_UNION_TYPE is in effect, we
28469
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
1535 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
1536 #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
1537 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
1538 make_number (n)
60896
25e4a0f171b5 (make_number): The arg can be bigger than `int'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 60143
diff changeset
1539 EMACS_INT n;
28469
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
1540 {
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
1541 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
1542 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
1543 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
1544 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
1545 }
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
1546 #endif
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1547
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1548 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1549 String Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1550 ***********************************************************************/
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1551
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1552 /* 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
1553 string_block is allocated, all the Lisp_Strings it contains are
41831
fa7af2e13043 (Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents: 40977
diff changeset
1554 added to a free-list string_free_list. When a new Lisp_String is
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1555 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
1556 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
1557 we keep.
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1558
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1559 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
1560 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
1561 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
1562
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1563 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
1564 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
1565 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
1566 its sdata structure.
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 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
1569 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
1570 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
1571 `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
1572 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
1573 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
1574
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1575 /* 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
1576 is 8192 minus malloc overhead. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1577
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1578 #define SBLOCK_SIZE 8188
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1579
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1580 /* 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
1581 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
1582
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1583 #define LARGE_STRING_BYTES 1024
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1584
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1585 /* 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
1586 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
1587
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1588 struct sdata
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1589 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1590 /* 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
1591 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
1592 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
1593 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
1594 (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
1595 contents. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1596 struct Lisp_String *string;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1597
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1598 #ifdef GC_CHECK_STRING_BYTES
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1599
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1600 EMACS_INT nbytes;
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1601 unsigned char data[1];
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1602
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1603 #define SDATA_NBYTES(S) (S)->nbytes
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1604 #define SDATA_DATA(S) (S)->data
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1605
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1606 #else /* not GC_CHECK_STRING_BYTES */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1607
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1608 union
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1609 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1610 /* When STRING in non-null. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1611 unsigned char data[1];
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1612
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1613 /* When STRING is null. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1614 EMACS_INT nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1615 } u;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1616
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1617
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1618 #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
1619 #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
1620
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1621 #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
1622 };
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1623
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1624
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1625 /* 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
1626 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
1627 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
1628 as large as needed. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1629
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1630 struct sblock
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 /* Next in list. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1633 struct sblock *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1634
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1635 /* 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
1636 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
1637 struct sdata *next_free;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1638
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1639 /* Start of data. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1640 struct sdata first_data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1641 };
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1642
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1643 /* 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
1644 1024 minus malloc overhead. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1645
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
1646 #define STRING_BLOCK_SIZE \
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1647 ((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
1648
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1649 /* 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
1650 are allocated. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1651
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1652 struct string_block
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1653 {
53582
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
1654 /* Place `strings' first, to preserve alignment. */
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
1655 struct Lisp_String strings[STRING_BLOCK_SIZE];
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1656 struct string_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1657 };
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1658
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1659 /* 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
1660 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
1661 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
1662
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1663 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
1664
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1665 /* List of sblocks for large strings. */
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 static struct sblock *large_sblocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1668
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1669 /* 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
1670
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1671 static struct string_block *string_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1672 static int n_string_blocks;
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 /* Free-list of Lisp_Strings. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1675
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1676 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
1677
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1678 /* 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
1679
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1680 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
1681
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1682 /* 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
1683
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1684 static int total_string_size;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1685
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1686 /* 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
1687 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
1688 free-list. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1689
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1690 #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
1691
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1692 /* 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
1693 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
1694 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
1695 structure starts at a constant offset in front of that. */
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1696
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1697 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1698
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1699 #define SDATA_OF_STRING(S) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1700 ((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
1701 - sizeof (EMACS_INT)))
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1702
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1703 #else /* not GC_CHECK_STRING_BYTES */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1704
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1705 #define SDATA_OF_STRING(S) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1706 ((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
1707
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1708 #endif /* not GC_CHECK_STRING_BYTES */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1709
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1710
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1711 #ifdef GC_CHECK_STRING_OVERRUN
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1712
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1713 /* We check for overrun in string data blocks by appending a small
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1714 "cookie" after each allocated string data block, and check for the
62681
d140f1408030 Fix typo in comment.
Juanma Barranquero <lekktu@gmail.com>
parents: 62335
diff changeset
1715 presence of this cookie during GC. */
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1716
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1717 #define GC_STRING_OVERRUN_COOKIE_SIZE 4
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1718 static char string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1719 { 0xde, 0xad, 0xbe, 0xef };
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1720
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1721 #else
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1722 #define GC_STRING_OVERRUN_COOKIE_SIZE 0
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1723 #endif
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1724
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1725 /* 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
1726 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
1727 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
1728
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1729 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1730
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1731 #define SDATA_SIZE(NBYTES) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1732 ((sizeof (struct Lisp_String *) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1733 + (NBYTES) + 1 \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1734 + sizeof (EMACS_INT) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1735 + sizeof (EMACS_INT) - 1) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1736 & ~(sizeof (EMACS_INT) - 1))
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1737
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1738 #else /* not GC_CHECK_STRING_BYTES */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1739
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1740 #define SDATA_SIZE(NBYTES) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1741 ((sizeof (struct Lisp_String *) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1742 + (NBYTES) + 1 \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1743 + sizeof (EMACS_INT) - 1) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1744 & ~(sizeof (EMACS_INT) - 1))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1745
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1746 #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
1747
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1748 /* Extra bytes to allocate for each string. */
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1749
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1750 #define GC_STRING_EXTRA (GC_STRING_OVERRUN_COOKIE_SIZE)
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1751
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1752 /* 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
1753
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
1754 static void
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1755 init_strings ()
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1756 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1757 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
1758 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
1759 string_blocks = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1760 n_string_blocks = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1761 string_free_list = NULL;
81272
1842d7137ff2 (init_strings): Initialize canonical empty strings.
Juanma Barranquero <lekktu@gmail.com>
parents: 77260
diff changeset
1762 empty_unibyte_string = make_pure_string ("", 0, 0, 0);
1842d7137ff2 (init_strings): Initialize canonical empty strings.
Juanma Barranquero <lekktu@gmail.com>
parents: 77260
diff changeset
1763 empty_multibyte_string = make_pure_string ("", 0, 0, 1);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1764 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1765
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1766
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1767 #ifdef GC_CHECK_STRING_BYTES
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1768
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1769 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
1770
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
1771 static void check_string_bytes P_ ((int));
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
1772 static void check_sblock P_ ((struct sblock *));
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1773
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1774 #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
1775
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1776
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1777 /* 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
1778
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1779 int
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1780 string_bytes (s)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1781 struct Lisp_String *s;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1782 {
51985
b52e88c3d6d0 (MARK_STRING, UNMARK_STRING, STRING_MARKED_P)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51974
diff changeset
1783 int nbytes = (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1784 if (!PURE_POINTER_P (s)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1785 && s->data
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1786 && 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
1787 abort ();
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1788 return nbytes;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1789 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1790
49529
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
1791 /* Check validity of Lisp strings' string_bytes member in B. */
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1792
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
1793 static void
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1794 check_sblock (b)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1795 struct sblock *b;
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1796 {
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1797 struct sdata *from, *end, *from_end;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1798
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1799 end = b->next_free;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1800
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1801 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
1802 {
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1803 /* 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
1804 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
1805 int nbytes;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1806
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1807 /* 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
1808 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
1809 if (from->string)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1810 CHECK_STRING_BYTES (from->string);
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1811
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1812 if (from->string)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1813 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
1814 else
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1815 nbytes = SDATA_NBYTES (from);
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1816
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1817 nbytes = SDATA_SIZE (nbytes);
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1818 from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1819 }
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1820 }
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1821
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1822
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1823 /* 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
1824 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
1825 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
1826
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
1827 static void
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1828 check_string_bytes (all_p)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1829 int all_p;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1830 {
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1831 if (all_p)
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1832 {
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1833 struct sblock *b;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1834
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1835 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
1836 {
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1837 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
1838 if (s)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1839 CHECK_STRING_BYTES (s);
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1840 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1841
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1842 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
1843 check_sblock (b);
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1844 }
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1845 else
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1846 check_sblock (current_sblock);
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1847 }
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1848
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1849 #endif /* GC_CHECK_STRING_BYTES */
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1850
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1851 #ifdef GC_CHECK_STRING_FREE_LIST
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1852
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1853 /* Walk through the string free list looking for bogus next pointers.
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1854 This may catch buffer overrun from a previous string. */
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1855
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1856 static void
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1857 check_string_free_list ()
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1858 {
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1859 struct Lisp_String *s;
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1860
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1861 /* Pop a Lisp_String off the free-list. */
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1862 s = string_free_list;
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1863 while (s != NULL)
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1864 {
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1865 if ((unsigned)s < 1024)
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1866 abort();
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1867 s = NEXT_FREE_LISP_STRING (s);
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1868 }
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1869 }
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1870 #else
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1871 #define check_string_free_list()
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1872 #endif
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1873
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1874 /* Return a new Lisp_String. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1875
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1876 static struct Lisp_String *
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1877 allocate_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 struct Lisp_String *s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1880
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
1881 /* eassert (!handling_signal); */
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
1882
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
1883 MALLOC_BLOCK_INPUT;
68350
263a4edafafa (lisp_align_free): Add an assertion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 67494
diff changeset
1884
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1885 /* 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
1886 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
1887 if (string_free_list == NULL)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1888 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1889 struct string_block *b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1890 int i;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1891
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1892 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
1893 bzero (b, sizeof *b);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1894 b->next = string_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1895 string_blocks = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1896 ++n_string_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1897
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
1898 for (i = STRING_BLOCK_SIZE - 1; i >= 0; --i)
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 s = b->strings + i;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1901 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
1902 string_free_list = s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1903 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1904
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
1905 total_free_strings += STRING_BLOCK_SIZE;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1906 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1907
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
1908 check_string_free_list ();
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1909
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1910 /* 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
1911 s = string_free_list;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1912 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
1913
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
1914 MALLOC_UNBLOCK_INPUT;
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
1915
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1916 /* 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
1917 bzero (s, sizeof *s);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1918
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1919 --total_free_strings;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1920 ++total_strings;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1921 ++strings_consed;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1922 consing_since_gc += sizeof *s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1923
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1924 #ifdef GC_CHECK_STRING_BYTES
87730
91da483b3fa5 * movemail.c:
Dan Nicolaescu <dann@ics.uci.edu>
parents: 87649
diff changeset
1925 if (!noninteractive)
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1926 {
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1927 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
1928 {
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1929 check_string_bytes_count = 0;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1930 check_string_bytes (1);
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1931 }
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1932 else
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1933 check_string_bytes (0);
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1934 }
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1935 #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
1936
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1937 return s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1938 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1939
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1940
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1941 /* 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
1942 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
1943 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
1944 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
1945 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
1946
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1947 void
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1948 allocate_string_data (s, nchars, nbytes)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1949 struct Lisp_String *s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1950 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1951 {
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1952 struct sdata *data, *old_data;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1953 struct sblock *b;
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1954 int needed, old_nbytes;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1955
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1956 /* 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
1957 of string data. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1958 needed = SDATA_SIZE (nbytes);
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
1959 old_data = s->data ? SDATA_OF_STRING (s) : NULL;
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
1960 old_nbytes = GC_STRING_BYTES (s);
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
1961
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
1962 MALLOC_BLOCK_INPUT;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1963
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1964 if (nbytes > LARGE_STRING_BYTES)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1965 {
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
1966 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
1967
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1968 #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
1969 /* 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
1970 because mapped region contents are not preserved in
51318
0b5248964d32 Comment.
Dave Love <fx@gnu.org>
parents: 51252
diff changeset
1971 a dumped Emacs.
0b5248964d32 Comment.
Dave Love <fx@gnu.org>
parents: 51252
diff changeset
1972
0b5248964d32 Comment.
Dave Love <fx@gnu.org>
parents: 51252
diff changeset
1973 In case you think of allowing it in a dumped Emacs at the
0b5248964d32 Comment.
Dave Love <fx@gnu.org>
parents: 51252
diff changeset
1974 cost of not being able to re-dump, there's another reason:
0b5248964d32 Comment.
Dave Love <fx@gnu.org>
parents: 51252
diff changeset
1975 mmap'ed data typically have an address towards the top of the
0b5248964d32 Comment.
Dave Love <fx@gnu.org>
parents: 51252
diff changeset
1976 address space, which won't fit into an EMACS_INT (at least on
0b5248964d32 Comment.
Dave Love <fx@gnu.org>
parents: 51252
diff changeset
1977 32-bit systems with the current tagging scheme). --fx */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1978 mallopt (M_MMAP_MAX, 0);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1979 #endif
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1980
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1981 b = (struct sblock *) lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1982
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1983 #ifdef DOUG_LEA_MALLOC
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1984 /* 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
1985 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
1986 #endif
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
1987
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1988 b->next_free = &b->first_data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1989 b->first_data.string = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1990 b->next = large_sblocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1991 large_sblocks = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1992 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1993 else if (current_sblock == NULL
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1994 || (((char *) current_sblock + SBLOCK_SIZE
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1995 - (char *) current_sblock->next_free)
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
1996 < (needed + GC_STRING_EXTRA)))
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1997 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1998 /* 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
1999 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
2000 b->next_free = &b->first_data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2001 b->first_data.string = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2002 b->next = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2003
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2004 if (current_sblock)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2005 current_sblock->next = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2006 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2007 oldest_sblock = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2008 current_sblock = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2009 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2010 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2011 b = current_sblock;
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
2012
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2013 data = b->next_free;
68369
3422c551ad06 * alloc.c (allocate_string_data): Update next_free immediately, to
Chong Yidong <cyd@stupidchicken.com>
parents: 68350
diff changeset
2014 b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA);
3422c551ad06 * alloc.c (allocate_string_data): Update next_free immediately, to
Chong Yidong <cyd@stupidchicken.com>
parents: 68350
diff changeset
2015
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
2016 MALLOC_UNBLOCK_INPUT;
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
2017
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2018 data->string = s;
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
2019 s->data = SDATA_DATA (data);
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
2020 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
2021 SDATA_NBYTES (data) = nbytes;
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
2022 #endif
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2023 s->size = nchars;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2024 s->size_byte = nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2025 s->data[nbytes] = '\0';
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2026 #ifdef GC_CHECK_STRING_OVERRUN
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
2027 bcopy (string_overrun_cookie, (char *) data + needed,
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
2028 GC_STRING_OVERRUN_COOKIE_SIZE);
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2029 #endif
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2030
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
2031 /* 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
2032 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
2033 in it. */
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
2034 if (old_data)
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
2035 {
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
2036 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
2037 old_data->string = NULL;
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
2038 }
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
2039
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2040 consing_since_gc += needed;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2041 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2042
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2043
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2044 /* Sweep and compact strings. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2045
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2046 static void
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2047 sweep_strings ()
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2048 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2049 struct string_block *b, *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2050 struct string_block *live_blocks = NULL;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2051
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2052 string_free_list = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2053 total_strings = total_free_strings = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2054 total_string_size = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2055
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2056 /* 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
2057 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
2058 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2059 int i, nfree = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2060 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
2061
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2062 next = b->next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2063
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
2064 for (i = 0; i < STRING_BLOCK_SIZE; ++i)
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2065 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2066 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
2067
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2068 if (s->data)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2069 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2070 /* 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
2071 if (STRING_MARKED_P (s))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2072 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2073 /* 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
2074 UNMARK_STRING (s);
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2075
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2076 if (!NULL_INTERVAL_P (s->intervals))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2077 UNMARK_BALANCE_INTERVALS (s->intervals);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2078
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2079 ++total_strings;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2080 total_string_size += STRING_BYTES (s);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2081 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2082 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2083 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2084 /* 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
2085 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
2086
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2087 /* 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
2088 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
2089 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
2090 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
2091 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
2092 abort ();
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
2093 #else
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2094 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
2095 #endif
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2096 data->string = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2097
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2098 /* 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
2099 know it's free. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2100 s->data = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2101
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2102 /* 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
2103 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
2104 string_free_list = s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2105 ++nfree;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2106 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2107 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2108 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2109 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2110 /* 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
2111 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
2112 string_free_list = s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2113 ++nfree;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2114 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2115 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2116
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2117 /* 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
2118 the first two of them. */
51907
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
2119 if (nfree == STRING_BLOCK_SIZE
4073a8ee4fc0 (BLOCK_PADDING): Rename from ABLOCKS_PADDING. Update users.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51843
diff changeset
2120 && total_free_strings > STRING_BLOCK_SIZE)
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2121 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2122 lisp_free (b);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2123 --n_string_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2124 string_free_list = free_list_before;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2125 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2126 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2127 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2128 total_free_strings += nfree;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2129 b->next = live_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2130 live_blocks = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2131 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2132 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2133
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
2134 check_string_free_list ();
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2135
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2136 string_blocks = live_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2137 free_large_strings ();
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2138 compact_small_strings ();
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2139
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
2140 check_string_free_list ();
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2141 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2143
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2144 /* Free dead large strings. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2145
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2146 static void
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2147 free_large_strings ()
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2148 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2149 struct sblock *b, *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2150 struct sblock *live_blocks = NULL;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2151
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2152 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
2153 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2154 next = b->next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2155
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2156 if (b->first_data.string == NULL)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2157 lisp_free (b);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2158 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2159 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2160 b->next = live_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2161 live_blocks = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2162 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2163 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2164
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2165 large_sblocks = live_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2166 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2167
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2168
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2169 /* 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
2170 data of live strings after compaction. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2171
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2172 static void
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2173 compact_small_strings ()
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2174 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2175 struct sblock *b, *tb, *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2176 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
2177 struct sdata *to_end, *from_end;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2178
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2179 /* 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
2180 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
2181 tb = oldest_sblock;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2182 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
2183 to = &tb->first_data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2184
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2185 /* 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
2186 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
2187 copying will happen this way. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2188 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
2189 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2190 end = b->next_free;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2191 xassert ((char *) end <= (char *) b + SBLOCK_SIZE);
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2192
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2193 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
2194 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2195 /* 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
2196 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
2197 int nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2198
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
2199 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
2200 /* 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
2201 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
2202 if (from->string
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
2203 && 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
2204 abort ();
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
2205 #endif /* GC_CHECK_STRING_BYTES */
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2206
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2207 if (from->string)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2208 nbytes = GC_STRING_BYTES (from->string);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2209 else
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
2210 nbytes = SDATA_NBYTES (from);
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2211
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2212 if (nbytes > LARGE_STRING_BYTES)
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2213 abort ();
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2214
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2215 nbytes = SDATA_SIZE (nbytes);
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2216 from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2217
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2218 #ifdef GC_CHECK_STRING_OVERRUN
58707
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
2219 if (bcmp (string_overrun_cookie,
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
2220 ((char *) from_end) - GC_STRING_OVERRUN_COOKIE_SIZE,
57741ce4cd6b Add commentary for last change.
Kim F. Storm <storm@cua.dk>
parents: 58631
diff changeset
2221 GC_STRING_OVERRUN_COOKIE_SIZE))
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2222 abort ();
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2223 #endif
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2224
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2225 /* 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
2226 if (from->string)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2227 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2228 /* If TB is full, proceed with the next sblock. */
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2229 to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2230 if (to_end > tb_end)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2231 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2232 tb->next_free = to;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2233 tb = tb->next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2234 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
2235 to = &tb->first_data;
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2236 to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2237 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2238
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2239 /* 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
2240 if (from != to)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2241 {
30823
8ee3740aaf60 (compact_small_strings): Use safe_bcopy, add an
Gerd Moellmann <gerd@gnu.org>
parents: 30784
diff changeset
2242 xassert (tb != b || to <= from);
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2243 safe_bcopy ((char *) from, (char *) to, nbytes + GC_STRING_EXTRA);
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
2244 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
2245 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2246
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2247 /* 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
2248 to = to_end;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2249 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2250 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2251 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2252
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2253 /* 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
2254 we can free them. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2255 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
2256 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2257 next = b->next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2258 lisp_free (b);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2259 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2260
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2261 tb->next_free = to;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2262 tb->next = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2263 current_sblock = tb;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2264 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2265
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2266
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2267 DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,
55745
1c3b8ce97c63 (Fmake_string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 55720
diff changeset
2268 doc: /* Return a newly created string of length LENGTH, with INIT in each element.
1c3b8ce97c63 (Fmake_string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 55720
diff changeset
2269 LENGTH must be an integer.
1c3b8ce97c63 (Fmake_string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 55720
diff changeset
2270 INIT must be an integer that represents a character. */)
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2271 (length, init)
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2272 Lisp_Object length, init;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2273 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2274 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2275 register unsigned char *p, *end;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2276 int c, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2277
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40113
diff changeset
2278 CHECK_NATNUM (length);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40113
diff changeset
2279 CHECK_NUMBER (init);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2280
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2281 c = XINT (init);
88898
ac49af641799 (Fmake_string): Use ASCII_CHAR_P, not SINGLE_BYTE_CHAR_P.
Kenichi Handa <handa@m17n.org>
parents: 88353
diff changeset
2282 if (ASCII_CHAR_P (c))
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2283 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2284 nbytes = XINT (length);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2285 val = make_uninit_string (nbytes);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46305
diff changeset
2286 p = SDATA (val);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46305
diff changeset
2287 end = p + SCHARS (val);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2288 while (p != end)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2289 *p++ = c;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2290 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2291 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2292 {
33800
7f148cfbd1f7 (Fmake_string): Use MAX_MULTIBYTE_LENGTH, instead of hard coded `4'.
Kenichi Handa <handa@m17n.org>
parents: 33764
diff changeset
2293 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
2294 int len = CHAR_STRING (c, str);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2295
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2296 nbytes = len * XINT (length);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2297 val = make_uninit_multibyte_string (XINT (length), nbytes);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46305
diff changeset
2298 p = SDATA (val);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2299 end = p + nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2300 while (p != end)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2301 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2302 bcopy (str, p, len);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2303 p += len;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2304 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2305 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2306
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2307 *p = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2308 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2309 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2310
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2311
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2312 DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
68741
2892a36e596e (Fmake_bool_vector, Fpurecopy): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 68430
diff changeset
2313 doc: /* Return a new bool-vector of length LENGTH, using INIT for each element.
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2314 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
2315 (length, init)
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2316 Lisp_Object length, init;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2317 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2318 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2319 struct Lisp_Bool_Vector *p;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2320 int real_init, i;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2321 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
2322
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40113
diff changeset
2323 CHECK_NATNUM (length);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2324
55159
e4e9ec547c6f (Fmake_bool_vector): Use BOOL_VECTOR_BITS_PER_CHAR instead of
Andreas Schwab <schwab@suse.de>
parents: 53705
diff changeset
2325 bits_per_value = sizeof (EMACS_INT) * BOOL_VECTOR_BITS_PER_CHAR;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2326
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2327 length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
55159
e4e9ec547c6f (Fmake_bool_vector): Use BOOL_VECTOR_BITS_PER_CHAR instead of
Andreas Schwab <schwab@suse.de>
parents: 53705
diff changeset
2328 length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
e4e9ec547c6f (Fmake_bool_vector): Use BOOL_VECTOR_BITS_PER_CHAR instead of
Andreas Schwab <schwab@suse.de>
parents: 53705
diff changeset
2329 / BOOL_VECTOR_BITS_PER_CHAR);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2330
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2331 /* 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
2332 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
2333 val = Fmake_vector (make_number (length_in_elts + 1), Qnil);
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2334
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2335 /* Get rid of any bits that would cause confusion. */
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2336 XVECTOR (val)->size = 0; /* No Lisp_Object to trace in there. */
85022
96eb42c9e0e3 * window.h (struct window):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85021
diff changeset
2337 /* Use XVECTOR (val) rather than `p' because p->size is not TRT. */
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2338 XSETPVECTYPE (XVECTOR (val), PVEC_BOOL_VECTOR);
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2339
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2340 p = XBOOL_VECTOR (val);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2341 p->size = XFASTINT (length);
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2342
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2343 real_init = (NILP (init) ? 0 : -1);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2344 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
2345 p->data[i] = real_init;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2346
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2347 /* Clear the extraneous bits in the last byte. */
55159
e4e9ec547c6f (Fmake_bool_vector): Use BOOL_VECTOR_BITS_PER_CHAR instead of
Andreas Schwab <schwab@suse.de>
parents: 53705
diff changeset
2348 if (XINT (length) != length_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2349 p->data[length_in_chars - 1]
55159
e4e9ec547c6f (Fmake_bool_vector): Use BOOL_VECTOR_BITS_PER_CHAR instead of
Andreas Schwab <schwab@suse.de>
parents: 53705
diff changeset
2350 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2351
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2352 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2353 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2354
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2355
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2356 /* 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
2357 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
2358 multibyte, depending on the contents. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2359
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2360 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2361 make_string (contents, nbytes)
46459
0a9cbcbdbe45 (xstrdup, make_string, make_unibyte_string)
Ken Raeburn <raeburn@raeburn.org>
parents: 46418
diff changeset
2362 const char *contents;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2363 int nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2364 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2365 register Lisp_Object val;
28997
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
2366 int nchars, multibyte_nbytes;
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
2367
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
2368 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
2369 if (nbytes == nchars || nbytes != multibyte_nbytes)
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
2370 /* 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
2371 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
2372 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
2373 else
dda5cbf94928 (make_string): Fix previous change. Be sure to make
Kenichi Handa <handa@m17n.org>
parents: 32776
diff changeset
2374 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
2375 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2376 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2377
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2378
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2379 /* 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
2380
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2381 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2382 make_unibyte_string (contents, length)
46459
0a9cbcbdbe45 (xstrdup, make_string, make_unibyte_string)
Ken Raeburn <raeburn@raeburn.org>
parents: 46418
diff changeset
2383 const char *contents;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2384 int length;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2385 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2386 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2387 val = make_uninit_string (length);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46305
diff changeset
2388 bcopy (contents, SDATA (val), length);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46305
diff changeset
2389 STRING_SET_UNIBYTE (val);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2390 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2391 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2392
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2393
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2394 /* 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
2395 bytes at CONTENTS. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2396
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2397 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2398 make_multibyte_string (contents, nchars, nbytes)
46459
0a9cbcbdbe45 (xstrdup, make_string, make_unibyte_string)
Ken Raeburn <raeburn@raeburn.org>
parents: 46418
diff changeset
2399 const char *contents;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2400 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2401 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2402 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2403 val = make_uninit_multibyte_string (nchars, nbytes);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46305
diff changeset
2404 bcopy (contents, SDATA (val), nbytes);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2405 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2406 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2407
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2408
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2409 /* 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
2410 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
2411
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2412 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2413 make_string_from_bytes (contents, nchars, nbytes)
50274
a617ca0d5d85 (make_string_from_bytes): Add `const' for the arg
Kenichi Handa <handa@m17n.org>
parents: 50200
diff changeset
2414 const char *contents;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2415 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2416 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2417 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2418 val = make_uninit_multibyte_string (nchars, nbytes);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46305
diff changeset
2419 bcopy (contents, SDATA (val), nbytes);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46305
diff changeset
2420 if (SBYTES (val) == SCHARS (val))
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46305
diff changeset
2421 STRING_SET_UNIBYTE (val);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2422 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2423 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2424
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2425
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2426 /* 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
2427 CONTENTS. The argument MULTIBYTE controls whether to label the
50200
fdeb795fc0ec (make_specified_string): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 49911
diff changeset
2428 string as multibyte. If NCHARS is negative, it counts the number of
fdeb795fc0ec (make_specified_string): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 49911
diff changeset
2429 characters by itself. */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2430
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2431 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2432 make_specified_string (contents, nchars, nbytes, multibyte)
50274
a617ca0d5d85 (make_string_from_bytes): Add `const' for the arg
Kenichi Handa <handa@m17n.org>
parents: 50200
diff changeset
2433 const char *contents;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2434 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2435 int multibyte;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2436 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2437 register Lisp_Object val;
50200
fdeb795fc0ec (make_specified_string): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 49911
diff changeset
2438
fdeb795fc0ec (make_specified_string): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 49911
diff changeset
2439 if (nchars < 0)
fdeb795fc0ec (make_specified_string): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 49911
diff changeset
2440 {
fdeb795fc0ec (make_specified_string): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 49911
diff changeset
2441 if (multibyte)
fdeb795fc0ec (make_specified_string): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 49911
diff changeset
2442 nchars = multibyte_chars_in_text (contents, nbytes);
fdeb795fc0ec (make_specified_string): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 49911
diff changeset
2443 else
fdeb795fc0ec (make_specified_string): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 49911
diff changeset
2444 nchars = nbytes;
fdeb795fc0ec (make_specified_string): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 49911
diff changeset
2445 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2446 val = make_uninit_multibyte_string (nchars, nbytes);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46305
diff changeset
2447 bcopy (contents, SDATA (val), nbytes);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2448 if (!multibyte)
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46305
diff changeset
2449 STRING_SET_UNIBYTE (val);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2450 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2451 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2452
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2453
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2454 /* 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
2455 data warrants. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2456
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2457 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2458 build_string (str)
46459
0a9cbcbdbe45 (xstrdup, make_string, make_unibyte_string)
Ken Raeburn <raeburn@raeburn.org>
parents: 46418
diff changeset
2459 const char *str;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2460 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2461 return make_string (str, strlen (str));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2462 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2463
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2464
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2465 /* 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
2466 occupying LENGTH bytes. */
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 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2469 make_uninit_string (length)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2470 int length;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2471 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2472 Lisp_Object val;
81272
1842d7137ff2 (init_strings): Initialize canonical empty strings.
Juanma Barranquero <lekktu@gmail.com>
parents: 77260
diff changeset
2473
1842d7137ff2 (init_strings): Initialize canonical empty strings.
Juanma Barranquero <lekktu@gmail.com>
parents: 77260
diff changeset
2474 if (!length)
1842d7137ff2 (init_strings): Initialize canonical empty strings.
Juanma Barranquero <lekktu@gmail.com>
parents: 77260
diff changeset
2475 return empty_unibyte_string;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2476 val = make_uninit_multibyte_string (length, length);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46305
diff changeset
2477 STRING_SET_UNIBYTE (val);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2478 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2479 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2480
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2481
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2482 /* 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
2483 which occupy NBYTES bytes. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2484
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2485 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2486 make_uninit_multibyte_string (nchars, nbytes)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2487 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2488 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2489 Lisp_Object string;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2490 struct Lisp_String *s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2491
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2492 if (nchars < 0)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2493 abort ();
81272
1842d7137ff2 (init_strings): Initialize canonical empty strings.
Juanma Barranquero <lekktu@gmail.com>
parents: 77260
diff changeset
2494 if (!nbytes)
1842d7137ff2 (init_strings): Initialize canonical empty strings.
Juanma Barranquero <lekktu@gmail.com>
parents: 77260
diff changeset
2495 return empty_multibyte_string;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2496
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2497 s = allocate_string ();
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2498 allocate_string_data (s, nchars, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2499 XSETSTRING (string, s);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2500 string_chars_consed += nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2501 return string;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2502 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2503
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2504
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2505
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2506 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2507 Float Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2508 ***********************************************************************/
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
2509
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2510 /* 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
2511 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
2512 by GC are put on a free list to be reallocated before allocating
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2513 any new float cells from the latest float_block. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2514
53582
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
2515 #define FLOAT_BLOCK_SIZE \
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
2516 (((BLOCK_BYTES - sizeof (struct float_block *) \
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
2517 /* The compiler might add padding at the end. */ \
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
2518 - (sizeof (struct Lisp_Float) - sizeof (int))) * CHAR_BIT) \
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2519 / (sizeof (struct Lisp_Float) * CHAR_BIT + 1))
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2520
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2521 #define GETMARKBIT(block,n) \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2522 (((block)->gcmarkbits[(n) / (sizeof(int) * CHAR_BIT)] \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2523 >> ((n) % (sizeof(int) * CHAR_BIT))) \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2524 & 1)
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2525
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2526 #define SETMARKBIT(block,n) \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2527 (block)->gcmarkbits[(n) / (sizeof(int) * CHAR_BIT)] \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2528 |= 1 << ((n) % (sizeof(int) * CHAR_BIT))
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2529
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2530 #define UNSETMARKBIT(block,n) \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2531 (block)->gcmarkbits[(n) / (sizeof(int) * CHAR_BIT)] \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2532 &= ~(1 << ((n) % (sizeof(int) * CHAR_BIT)))
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2533
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2534 #define FLOAT_BLOCK(fptr) \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2535 ((struct float_block *)(((EMACS_UINT)(fptr)) & ~(BLOCK_ALIGN - 1)))
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2536
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2537 #define FLOAT_INDEX(fptr) \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2538 ((((EMACS_UINT)(fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Float))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2539
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2540 struct float_block
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2541 {
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2542 /* Place `floats' at the beginning, to ease up FLOAT_INDEX's job. */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2543 struct Lisp_Float floats[FLOAT_BLOCK_SIZE];
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2544 int gcmarkbits[1 + FLOAT_BLOCK_SIZE / (sizeof(int) * CHAR_BIT)];
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2545 struct float_block *next;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2546 };
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2547
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2548 #define FLOAT_MARKED_P(fptr) \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2549 GETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr)))
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2550
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2551 #define FLOAT_MARK(fptr) \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2552 SETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr)))
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2553
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2554 #define FLOAT_UNMARK(fptr) \
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2555 UNSETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr)))
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2556
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2557 /* Current float_block. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2558
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2559 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
2560
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2561 /* 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
2562
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2563 int float_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2564
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2565 /* 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
2566
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2567 int n_float_blocks;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2568
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2569 /* 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
2570
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2571 struct Lisp_Float *float_free_list;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2572
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2573
39297
aff361cfdccb Fix a typo in a comment. From Pavel Janik.
Eli Zaretskii <eliz@gnu.org>
parents: 39228
diff changeset
2574 /* Initialize float allocation. */
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2575
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
2576 static void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2577 init_float ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2578 {
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2579 float_block = NULL;
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2580 float_block_index = FLOAT_BLOCK_SIZE; /* Force alloc of new float_block. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2581 float_free_list = 0;
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2582 n_float_blocks = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2583 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2584
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2585
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2586 /* 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
2587
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
2588 static void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2589 free_float (ptr)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2590 struct Lisp_Float *ptr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2591 {
66889
e485868e3caf (free_float): Make free list chaining aliasing-safe.
Andreas Schwab <schwab@suse.de>
parents: 66777
diff changeset
2592 ptr->u.chain = float_free_list;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2593 float_free_list = ptr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2594 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2595
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2596
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2597 /* 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
2598
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2599 Lisp_Object
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2600 make_float (float_value)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2601 double float_value;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2602 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2603 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2604
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
2605 /* eassert (!handling_signal); */
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
2606
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
2607 MALLOC_BLOCK_INPUT;
68350
263a4edafafa (lisp_align_free): Add an assertion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 67494
diff changeset
2608
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2609 if (float_free_list)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2610 {
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
2611 /* 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
2612 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
2613 XSETFLOAT (val, float_free_list);
66889
e485868e3caf (free_float): Make free list chaining aliasing-safe.
Andreas Schwab <schwab@suse.de>
parents: 66777
diff changeset
2614 float_free_list = float_free_list->u.chain;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2615 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2616 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2617 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2618 if (float_block_index == FLOAT_BLOCK_SIZE)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2619 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
2620 register struct float_block *new;
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
2621
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2622 new = (struct float_block *) lisp_align_malloc (sizeof *new,
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
2623 MEM_TYPE_FLOAT);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2624 new->next = float_block;
53093
e8f5463f3d5b (make_float, Fcons): Clear the markbit at init time.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52837
diff changeset
2625 bzero ((char *) new->gcmarkbits, sizeof new->gcmarkbits);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2626 float_block = new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2627 float_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2628 n_float_blocks++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2629 }
53093
e8f5463f3d5b (make_float, Fcons): Clear the markbit at init time.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52837
diff changeset
2630 XSETFLOAT (val, &float_block->floats[float_block_index]);
e8f5463f3d5b (make_float, Fcons): Clear the markbit at init time.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52837
diff changeset
2631 float_block_index++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2632 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2633
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
2634 MALLOC_UNBLOCK_INPUT;
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
2635
104313
73f76307d49b * lisp.h (XFLOAT_DATA): Produce an rvalue by adding 0 to the value.
Ken Raeburn <raeburn@raeburn.org>
parents: 101689
diff changeset
2636 XFLOAT_INIT (val, float_value);
53093
e8f5463f3d5b (make_float, Fcons): Clear the markbit at init time.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52837
diff changeset
2637 eassert (!FLOAT_MARKED_P (XFLOAT (val)));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2638 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
2639 floats_consed++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2640 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2641 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2642
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2643
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2644
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2645 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2646 Cons Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2647 ***********************************************************************/
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2648
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2649 /* We store cons cells inside of cons_blocks, allocating a new
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2650 cons_block with malloc whenever necessary. Cons cells reclaimed by
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2651 GC are put on a free list to be reallocated before allocating
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2652 any new cons cells from the latest cons_block. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2653
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2654 #define CONS_BLOCK_SIZE \
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2655 (((BLOCK_BYTES - sizeof (struct cons_block *)) * CHAR_BIT) \
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2656 / (sizeof (struct Lisp_Cons) * CHAR_BIT + 1))
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2657
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2658 #define CONS_BLOCK(fptr) \
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2659 ((struct cons_block *)(((EMACS_UINT)(fptr)) & ~(BLOCK_ALIGN - 1)))
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2660
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2661 #define CONS_INDEX(fptr) \
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2662 ((((EMACS_UINT)(fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Cons))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2663
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2664 struct cons_block
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2665 {
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2666 /* Place `conses' at the beginning, to ease up CONS_INDEX's job. */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2667 struct Lisp_Cons conses[CONS_BLOCK_SIZE];
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2668 int gcmarkbits[1 + CONS_BLOCK_SIZE / (sizeof(int) * CHAR_BIT)];
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2669 struct cons_block *next;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2670 };
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2671
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2672 #define CONS_MARKED_P(fptr) \
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2673 GETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2674
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2675 #define CONS_MARK(fptr) \
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2676 SETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2677
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2678 #define CONS_UNMARK(fptr) \
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2679 UNSETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2680
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2681 /* Current cons_block. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2682
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2683 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
2684
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2685 /* 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
2686
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2687 int cons_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2688
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2689 /* 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
2690
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2691 struct Lisp_Cons *cons_free_list;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2692
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2693 /* 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
2694
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
2695 static int n_cons_blocks;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2696
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2697
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2698 /* Initialize cons allocation. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2699
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
2700 static void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2701 init_cons ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2702 {
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2703 cons_block = NULL;
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2704 cons_block_index = CONS_BLOCK_SIZE; /* Force alloc of new cons_block. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2705 cons_free_list = 0;
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2706 n_cons_blocks = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2707 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2708
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2709
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2710 /* 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
2711
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
2712 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2713 free_cons (ptr)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2714 struct Lisp_Cons *ptr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2715 {
66889
e485868e3caf (free_float): Make free list chaining aliasing-safe.
Andreas Schwab <schwab@suse.de>
parents: 66777
diff changeset
2716 ptr->u.chain = cons_free_list;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2717 #if GC_MARK_STACK
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2718 ptr->car = Vdead;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2719 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2720 cons_free_list = ptr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2721 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2722
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2723 DEFUN ("cons", Fcons, Scons, 2, 2, 0,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
2724 doc: /* Create a new cons, give it CAR and CDR as components, and return it. */)
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2725 (car, cdr)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2726 Lisp_Object car, cdr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2727 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2728 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2729
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
2730 /* eassert (!handling_signal); */
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
2731
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
2732 MALLOC_BLOCK_INPUT;
68350
263a4edafafa (lisp_align_free): Add an assertion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 67494
diff changeset
2733
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2734 if (cons_free_list)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2735 {
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
2736 /* 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
2737 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
2738 XSETCONS (val, cons_free_list);
66889
e485868e3caf (free_float): Make free list chaining aliasing-safe.
Andreas Schwab <schwab@suse.de>
parents: 66777
diff changeset
2739 cons_free_list = cons_free_list->u.chain;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2740 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2741 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2742 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2743 if (cons_block_index == CONS_BLOCK_SIZE)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2744 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
2745 register struct cons_block *new;
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2746 new = (struct cons_block *) lisp_align_malloc (sizeof *new,
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
2747 MEM_TYPE_CONS);
53093
e8f5463f3d5b (make_float, Fcons): Clear the markbit at init time.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52837
diff changeset
2748 bzero ((char *) new->gcmarkbits, sizeof new->gcmarkbits);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2749 new->next = cons_block;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2750 cons_block = new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2751 cons_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2752 n_cons_blocks++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2753 }
53093
e8f5463f3d5b (make_float, Fcons): Clear the markbit at init time.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52837
diff changeset
2754 XSETCONS (val, &cons_block->conses[cons_block_index]);
e8f5463f3d5b (make_float, Fcons): Clear the markbit at init time.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52837
diff changeset
2755 cons_block_index++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2756 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2757
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
2758 MALLOC_UNBLOCK_INPUT;
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
2759
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39914
diff changeset
2760 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
2761 XSETCDR (val, cdr);
53093
e8f5463f3d5b (make_float, Fcons): Clear the markbit at init time.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52837
diff changeset
2762 eassert (!CONS_MARKED_P (XCONS (val)));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2763 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
2764 cons_cells_consed++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2765 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2766 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2767
56539
9fc5aae4053e (check_cons_list): New function (contents commented out).
Richard M. Stallman <rms@gnu.org>
parents: 56401
diff changeset
2768 /* Get an error now if there's any junk in the cons free list. */
9fc5aae4053e (check_cons_list): New function (contents commented out).
Richard M. Stallman <rms@gnu.org>
parents: 56401
diff changeset
2769 void
9fc5aae4053e (check_cons_list): New function (contents commented out).
Richard M. Stallman <rms@gnu.org>
parents: 56401
diff changeset
2770 check_cons_list ()
9fc5aae4053e (check_cons_list): New function (contents commented out).
Richard M. Stallman <rms@gnu.org>
parents: 56401
diff changeset
2771 {
58631
7c469d30a12d Add more checks for buffer overruns.
Kim F. Storm <storm@cua.dk>
parents: 58593
diff changeset
2772 #ifdef GC_CHECK_CONS_LIST
56539
9fc5aae4053e (check_cons_list): New function (contents commented out).
Richard M. Stallman <rms@gnu.org>
parents: 56401
diff changeset
2773 struct Lisp_Cons *tail = cons_free_list;
9fc5aae4053e (check_cons_list): New function (contents commented out).
Richard M. Stallman <rms@gnu.org>
parents: 56401
diff changeset
2774
9fc5aae4053e (check_cons_list): New function (contents commented out).
Richard M. Stallman <rms@gnu.org>
parents: 56401
diff changeset
2775 while (tail)
66889
e485868e3caf (free_float): Make free list chaining aliasing-safe.
Andreas Schwab <schwab@suse.de>
parents: 66777
diff changeset
2776 tail = tail->u.chain;
56539
9fc5aae4053e (check_cons_list): New function (contents commented out).
Richard M. Stallman <rms@gnu.org>
parents: 56401
diff changeset
2777 #endif
9fc5aae4053e (check_cons_list): New function (contents commented out).
Richard M. Stallman <rms@gnu.org>
parents: 56401
diff changeset
2778 }
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2779
71967
3254b987edcb (buffer_memory_full, memory_full): Use xsignal. Remove loop.
Kim F. Storm <storm@cua.dk>
parents: 69876
diff changeset
2780 /* Make a list of 1, 2, 3, 4 or 5 specified objects. */
3254b987edcb (buffer_memory_full, memory_full): Use xsignal. Remove loop.
Kim F. Storm <storm@cua.dk>
parents: 69876
diff changeset
2781
3254b987edcb (buffer_memory_full, memory_full): Use xsignal. Remove loop.
Kim F. Storm <storm@cua.dk>
parents: 69876
diff changeset
2782 Lisp_Object
3254b987edcb (buffer_memory_full, memory_full): Use xsignal. Remove loop.
Kim F. Storm <storm@cua.dk>
parents: 69876
diff changeset
2783 list1 (arg1)
3254b987edcb (buffer_memory_full, memory_full): Use xsignal. Remove loop.
Kim F. Storm <storm@cua.dk>
parents: 69876
diff changeset
2784 Lisp_Object arg1;
3254b987edcb (buffer_memory_full, memory_full): Use xsignal. Remove loop.
Kim F. Storm <storm@cua.dk>
parents: 69876
diff changeset
2785 {
3254b987edcb (buffer_memory_full, memory_full): Use xsignal. Remove loop.
Kim F. Storm <storm@cua.dk>
parents: 69876
diff changeset
2786 return Fcons (arg1, Qnil);
3254b987edcb (buffer_memory_full, memory_full): Use xsignal. Remove loop.
Kim F. Storm <storm@cua.dk>
parents: 69876
diff changeset
2787 }
20849
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2788
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2789 Lisp_Object
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2790 list2 (arg1, arg2)
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2791 Lisp_Object arg1, arg2;
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2792 {
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2793 return Fcons (arg1, Fcons (arg2, Qnil));
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2794 }
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2795
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2796
20849
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2797 Lisp_Object
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2798 list3 (arg1, arg2, arg3)
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2799 Lisp_Object arg1, arg2, arg3;
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2800 {
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2801 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
2802 }
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2803
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2804
20849
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2805 Lisp_Object
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2806 list4 (arg1, arg2, arg3, arg4)
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2807 Lisp_Object arg1, arg2, arg3, arg4;
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2808 {
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2809 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
2810 }
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2811
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2812
20849
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2813 Lisp_Object
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2814 list5 (arg1, arg2, arg3, arg4, arg5)
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2815 Lisp_Object arg1, arg2, arg3, arg4, arg5;
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2816 {
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2817 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
2818 Fcons (arg5, Qnil)))));
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2819 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2820
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2821
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2822 DEFUN ("list", Flist, Slist, 0, MANY, 0,
40977
6ec709b442c8 (Flist): Reindent.
Pavel Janík <Pavel@Janik.cz>
parents: 40656
diff changeset
2823 doc: /* Return a newly created list with specified arguments as elements.
40113
66132b83e52a (Fmake_byte_code, Fvector, Flist): Add usage: string to doc string.
Miles Bader <miles@gnu.org>
parents: 40107
diff changeset
2824 Any number of arguments, even zero arguments, are allowed.
66132b83e52a (Fmake_byte_code, Fvector, Flist): Add usage: string to doc string.
Miles Bader <miles@gnu.org>
parents: 40107
diff changeset
2825 usage: (list &rest OBJECTS) */)
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2826 (nargs, args)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2827 int nargs;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2828 register Lisp_Object *args;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2829 {
13610
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
2830 register Lisp_Object val;
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
2831 val = Qnil;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2832
13610
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
2833 while (nargs > 0)
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
2834 {
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
2835 nargs--;
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
2836 val = Fcons (args[nargs], val);
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
2837 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2838 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2839 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2840
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2841
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2842 DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
2843 doc: /* Return a newly created list of length LENGTH, with each element being INIT. */)
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2844 (length, init)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2845 register Lisp_Object length, init;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2846 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2847 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2848 register int size;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2849
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40113
diff changeset
2850 CHECK_NATNUM (length);
9953
e0672d4cf470 (Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents: 9942
diff changeset
2851 size = XFASTINT (length);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2852
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2853 val = Qnil;
35762
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2854 while (size > 0)
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2855 {
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2856 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
2857 --size;
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2858
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2859 if (size > 0)
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2860 {
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2861 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
2862 --size;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2863
35762
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2864 if (size > 0)
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2865 {
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2866 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
2867 --size;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2868
35762
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2869 if (size > 0)
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2870 {
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2871 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
2872 --size;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2873
35762
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2874 if (size > 0)
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2875 {
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2876 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
2877 --size;
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2878 }
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2879 }
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2880 }
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2881 }
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2882
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2883 QUIT;
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2884 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2885
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2886 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2887 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2888
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2889
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2890
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2891 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2892 Vector Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2893 ***********************************************************************/
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2894
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2895 /* 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
2896
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
2897 static struct Lisp_Vector *all_vectors;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2898
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2899 /* 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
2900
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
2901 static int n_vectors;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2902
27738
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 /* 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
2905 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
2906
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2907 static struct Lisp_Vector *
84978
33b7fe948502 (enum mem_type): Replace all vector subtypes -> MEM_TYPE_VECTORLIKE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84977
diff changeset
2908 allocate_vectorlike (len)
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2909 EMACS_INT len;
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2910 {
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2911 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
2912 size_t nbytes;
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2913
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
2914 MALLOC_BLOCK_INPUT;
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
2915
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
2916 #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
2917 /* 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
2918 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
2919 a dumped Emacs. */
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
2920 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
2921 #endif
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2922
68350
263a4edafafa (lisp_align_free): Add an assertion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 67494
diff changeset
2923 /* This gets triggered by code which I haven't bothered to fix. --Stef */
263a4edafafa (lisp_align_free): Add an assertion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 67494
diff changeset
2924 /* eassert (!handling_signal); */
263a4edafafa (lisp_align_free): Add an assertion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 67494
diff changeset
2925
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2926 nbytes = sizeof *p + (len - 1) * sizeof p->contents[0];
84978
33b7fe948502 (enum mem_type): Replace all vector subtypes -> MEM_TYPE_VECTORLIKE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84977
diff changeset
2927 p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2928
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
2929 #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
2930 /* 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
2931 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
2932 #endif
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2933
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2934 consing_since_gc += nbytes;
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
2935 vector_cells_consed += len;
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2936
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2937 p->next = all_vectors;
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2938 all_vectors = p;
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
2939
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
2940 MALLOC_UNBLOCK_INPUT;
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
2941
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2942 ++n_vectors;
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2943 return p;
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2944 }
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2945
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2946
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2947 /* Allocate a vector with NSLOTS slots. */
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2948
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2949 struct Lisp_Vector *
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2950 allocate_vector (nslots)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2951 EMACS_INT nslots;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2952 {
84978
33b7fe948502 (enum mem_type): Replace all vector subtypes -> MEM_TYPE_VECTORLIKE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84977
diff changeset
2953 struct Lisp_Vector *v = allocate_vectorlike (nslots);
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2954 v->size = nslots;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2955 return v;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2956 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2957
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2958
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2959 /* Allocate other vector-like structures. */
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2960
86160
1ede747999c6 * alloc.c (ALLOCATE_PSEUDOVECTOR): Move to lisp.h.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85674
diff changeset
2961 struct Lisp_Vector *
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2962 allocate_pseudovector (memlen, lisplen, tag)
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2963 int memlen, lisplen;
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2964 EMACS_INT tag;
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2965 {
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2966 struct Lisp_Vector *v = allocate_vectorlike (memlen);
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2967 EMACS_INT i;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2968
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2969 /* Only the first lisplen slots will be traced normally by the GC. */
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2970 v->size = lisplen;
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2971 for (i = 0; i < lisplen; ++i)
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2972 v->contents[i] = Qnil;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
2973
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2974 XSETPVECTYPE (v, tag); /* Add the appropriate tag. */
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2975 return v;
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2976 }
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2977
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2978 struct Lisp_Hash_Table *
85021
a0c901e4e649 * lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85020
diff changeset
2979 allocate_hash_table (void)
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2980 {
85021
a0c901e4e649 * lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85020
diff changeset
2981 return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, count, PVEC_HASH_TABLE);
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2982 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2983
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2984
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2985 struct window *
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2986 allocate_window ()
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2987 {
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2988 return ALLOCATE_PSEUDOVECTOR(struct window, current_matrix, PVEC_WINDOW);
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2989 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2990
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2991
84693
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
2992 struct terminal *
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
2993 allocate_terminal ()
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
2994 {
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2995 struct terminal *t = ALLOCATE_PSEUDOVECTOR (struct terminal,
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2996 next_terminal, PVEC_TERMINAL);
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2997 /* Zero out the non-GC'd fields. FIXME: This should be made unnecessary. */
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2998 bzero (&(t->next_terminal),
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
2999 ((char*)(t+1)) - ((char*)&(t->next_terminal)));
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
3000
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
3001 return t;
84693
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
3002 }
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
3003
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3004 struct frame *
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3005 allocate_frame ()
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3006 {
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
3007 struct frame *f = ALLOCATE_PSEUDOVECTOR (struct frame,
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
3008 face_cache, PVEC_FRAME);
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
3009 /* Zero out the non-GC'd fields. FIXME: This should be made unnecessary. */
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
3010 bzero (&(f->face_cache),
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
3011 ((char*)(f+1)) - ((char*)&(f->face_cache)));
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
3012 return f;
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3013 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3014
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3015
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3016 struct Lisp_Process *
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3017 allocate_process ()
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3018 {
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
3019 return ALLOCATE_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3020 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3021
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3022
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3023 DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
3024 doc: /* Return a newly created vector of length LENGTH, with each element being INIT.
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3025 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
3026 (length, init)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3027 register Lisp_Object length, init;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3028 {
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
3029 Lisp_Object vector;
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
3030 register EMACS_INT sizei;
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
3031 register int index;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3032 register struct Lisp_Vector *p;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3033
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40113
diff changeset
3034 CHECK_NATNUM (length);
9953
e0672d4cf470 (Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents: 9942
diff changeset
3035 sizei = XFASTINT (length);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3036
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3037 p = allocate_vector (sizei);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3038 for (index = 0; index < sizei; index++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3039 p->contents[index] = init;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3040
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
3041 XSETVECTOR (vector, p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3042 return vector;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3043 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3044
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3045
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3046 DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
40977
6ec709b442c8 (Flist): Reindent.
Pavel Janík <Pavel@Janik.cz>
parents: 40656
diff changeset
3047 doc: /* Return a newly created vector with specified arguments as elements.
40113
66132b83e52a (Fmake_byte_code, Fvector, Flist): Add usage: string to doc string.
Miles Bader <miles@gnu.org>
parents: 40107
diff changeset
3048 Any number of arguments, even zero arguments, are allowed.
66132b83e52a (Fmake_byte_code, Fvector, Flist): Add usage: string to doc string.
Miles Bader <miles@gnu.org>
parents: 40107
diff changeset
3049 usage: (vector &rest OBJECTS) */)
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3050 (nargs, args)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3051 register int nargs;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3052 Lisp_Object *args;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3053 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3054 register Lisp_Object len, val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3055 register int index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3056 register struct Lisp_Vector *p;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3057
9295
17d393a8eed6 (free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents: 9261
diff changeset
3058 XSETFASTINT (len, nargs);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3059 val = Fmake_vector (len, Qnil);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3060 p = XVECTOR (val);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3061 for (index = 0; index < nargs; index++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3062 p->contents[index] = args[index];
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3063 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3064 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3065
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3066
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3067 DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
3068 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
3069 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
3070 stack size, (optional) doc string, and (optional) interactive spec.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
3071 The first four arguments are required; at most six have any
40113
66132b83e52a (Fmake_byte_code, Fvector, Flist): Add usage: string to doc string.
Miles Bader <miles@gnu.org>
parents: 40107
diff changeset
3072 significance.
50626
a5a77c7717cb (Fmake_byte_code): Improve the `usage' string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50468
diff changeset
3073 usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3074 (nargs, args)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3075 register int nargs;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3076 Lisp_Object *args;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3077 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3078 register Lisp_Object len, val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3079 register int index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3080 register struct Lisp_Vector *p;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3081
9295
17d393a8eed6 (free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents: 9261
diff changeset
3082 XSETFASTINT (len, nargs);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 434
diff changeset
3083 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
3084 val = make_pure_vector ((EMACS_INT) nargs);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3085 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3086 val = Fmake_vector (len, Qnil);
28997
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
3087
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
3088 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
3089 /* 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
3090 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
3091 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
3092 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
3093 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
3094 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
3095
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3096 p = XVECTOR (val);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3097 for (index = 0; index < nargs; index++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3098 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 434
diff changeset
3099 if (!NILP (Vpurify_flag))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3100 args[index] = Fpurecopy (args[index]);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3101 p->contents[index] = args[index];
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3102 }
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
3103 XSETPVECTYPE (p, PVEC_COMPILED);
18104
b2a669ef69b1 (Fmake_byte_code): Set val from p, not from val.
Richard M. Stallman <rms@gnu.org>
parents: 18010
diff changeset
3104 XSETCOMPILED (val, p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3105 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3106 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3107
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3108
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3109
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3110 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3111 Symbol Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3112 ***********************************************************************/
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3113
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3114 /* 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
3115 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
3116 own overhead. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3117
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3118 #define SYMBOL_BLOCK_SIZE \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3119 ((1020 - sizeof (struct symbol_block *)) / sizeof (struct Lisp_Symbol))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3120
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3121 struct symbol_block
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3122 {
53582
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
3123 /* Place `symbols' first, to preserve alignment. */
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
3124 struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE];
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3125 struct symbol_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3126 };
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3127
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3128 /* 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
3129 structure in it. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3130
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
3131 static struct symbol_block *symbol_block;
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
3132 static int symbol_block_index;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3133
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3134 /* List of free symbols. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3135
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
3136 static struct Lisp_Symbol *symbol_free_list;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3137
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
3138 /* 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
3139
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
3140 static int n_symbol_blocks;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
3141
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3142
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3143 /* Initialize symbol allocation. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3144
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
3145 static void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3146 init_symbol ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3147 {
52473
a3fd06a8c844 (init_intervals, init_symbol, init_marker): Don't preallocate anything.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52453
diff changeset
3148 symbol_block = NULL;
a3fd06a8c844 (init_intervals, init_symbol, init_marker): Don't preallocate anything.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52453
diff changeset
3149 symbol_block_index = SYMBOL_BLOCK_SIZE;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3150 symbol_free_list = 0;
52473
a3fd06a8c844 (init_intervals, init_symbol, init_marker): Don't preallocate anything.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52453
diff changeset
3151 n_symbol_blocks = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3152 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3153
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3154
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3155 DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
3156 doc: /* Return a newly allocated uninterned symbol whose name is NAME.
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3157 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
3158 (name)
14093
338f645e6b9a (Fmake_symbol): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
3159 Lisp_Object name;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3160 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3161 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3162 register struct Lisp_Symbol *p;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3163
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40113
diff changeset
3164 CHECK_STRING (name);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3165
68974
977852fb2e3b (Fmake_symbol): Comment-out left-over assert from before we added BLOCK_INPUTs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 68741
diff changeset
3166 /* eassert (!handling_signal); */
68350
263a4edafafa (lisp_align_free): Add an assertion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 67494
diff changeset
3167
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
3168 MALLOC_BLOCK_INPUT;
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
3169
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3170 if (symbol_free_list)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3171 {
9261
e5ba7993d378 (VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents: 9144
diff changeset
3172 XSETSYMBOL (val, symbol_free_list);
66889
e485868e3caf (free_float): Make free list chaining aliasing-safe.
Andreas Schwab <schwab@suse.de>
parents: 66777
diff changeset
3173 symbol_free_list = symbol_free_list->next;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3174 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3175 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3176 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3177 if (symbol_block_index == SYMBOL_BLOCK_SIZE)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3178 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
3179 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
3180 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
3181 MEM_TYPE_SYMBOL);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3182 new->next = symbol_block;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3183 symbol_block = new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3184 symbol_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
3185 n_symbol_blocks++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3186 }
53093
e8f5463f3d5b (make_float, Fcons): Clear the markbit at init time.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52837
diff changeset
3187 XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]);
e8f5463f3d5b (make_float, Fcons): Clear the markbit at init time.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52837
diff changeset
3188 symbol_block_index++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3189 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3190
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
3191 MALLOC_UNBLOCK_INPUT;
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
3192
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3193 p = XSYMBOL (val);
45392
f3d7ab65641f * alloc.c (Fmake_symbol): Set symbol xname field instead of name.
Ken Raeburn <raeburn@raeburn.org>
parents: 44890
diff changeset
3194 p->xname = name;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3195 p->plist = Qnil;
107984
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
3196 p->redirect = SYMBOL_PLAINVAL;
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
3197 SET_SYMBOL_VAL (p, Qunbound);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3198 p->function = Qunbound;
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3199 p->next = NULL;
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
3200 p->gcmarkbit = 0;
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3201 p->interned = SYMBOL_UNINTERNED;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3202 p->constant = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3203 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
3204 symbols_consed++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3205 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3206 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3207
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3208
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3209
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3210 /***********************************************************************
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3211 Marker (Misc) Allocation
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3212 ***********************************************************************/
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3213
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3214 /* Allocation of markers and other objects that share that structure.
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3215 Works like allocation of conses. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3216
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3217 #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
3218 ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3219
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3220 struct marker_block
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
3221 {
53582
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
3222 /* Place `markers' first, to preserve alignment. */
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
3223 union Lisp_Misc markers[MARKER_BLOCK_SIZE];
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3224 struct marker_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3225 };
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3226
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
3227 static struct marker_block *marker_block;
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
3228 static int marker_block_index;
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
3229
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
3230 static union Lisp_Misc *marker_free_list;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3231
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
3232 /* 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
3233
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
3234 static int n_marker_blocks;
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
3235
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
3236 static void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3237 init_marker ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3238 {
52473
a3fd06a8c844 (init_intervals, init_symbol, init_marker): Don't preallocate anything.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52453
diff changeset
3239 marker_block = NULL;
a3fd06a8c844 (init_intervals, init_symbol, init_marker): Don't preallocate anything.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52453
diff changeset
3240 marker_block_index = MARKER_BLOCK_SIZE;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3241 marker_free_list = 0;
52473
a3fd06a8c844 (init_intervals, init_symbol, init_marker): Don't preallocate anything.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52453
diff changeset
3242 n_marker_blocks = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3243 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3244
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3245 /* 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
3246
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3247 Lisp_Object
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3248 allocate_misc ()
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3249 {
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3250 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
3251
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
3252 /* eassert (!handling_signal); */
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
3253
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
3254 MALLOC_BLOCK_INPUT;
68350
263a4edafafa (lisp_align_free): Add an assertion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 67494
diff changeset
3255
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3256 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
3257 {
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3258 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
3259 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
3260 }
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3261 else
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3262 {
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3263 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
3264 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
3265 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
3266 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
3267 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
3268 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
3269 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
3270 marker_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
3271 n_marker_blocks++;
56239
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3272 total_free_markers += 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
3273 }
53093
e8f5463f3d5b (make_float, Fcons): Clear the markbit at init time.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52837
diff changeset
3274 XSETMISC (val, &marker_block->markers[marker_block_index]);
e8f5463f3d5b (make_float, Fcons): Clear the markbit at init time.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52837
diff changeset
3275 marker_block_index++;
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3276 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3277
84977
3747382d60e9 (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): New macros
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84954
diff changeset
3278 MALLOC_UNBLOCK_INPUT;
68430
47782d80f30b * alloc.c (make_interval, allocate_string)
Chong Yidong <cyd@stupidchicken.com>
parents: 68398
diff changeset
3279
56239
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3280 --total_free_markers;
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3281 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
3282 misc_objects_consed++;
85328
d0d527210b0c * lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85023
diff changeset
3283 XMISCANY (val)->gcmarkbit = 0;
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3284 return val;
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3285 }
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3286
56239
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3287 /* Free a Lisp_Misc object */
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3288
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3289 void
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3290 free_misc (misc)
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3291 Lisp_Object misc;
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3292 {
85344
99492f857499 (free_misc): Use XMISCTYPE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85329
diff changeset
3293 XMISCTYPE (misc) = Lisp_Misc_Free;
56239
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3294 XMISC (misc)->u_free.chain = marker_free_list;
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3295 marker_free_list = XMISC (misc);
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3296
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3297 total_free_markers++;
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3298 }
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3299
49055
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3300 /* Return a Lisp_Misc_Save_Value object containing POINTER and
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3301 INTEGER. This is used to package C values to call record_unwind_protect.
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3302 The unwind function can get the C values back using XSAVE_VALUE. */
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3303
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3304 Lisp_Object
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3305 make_save_value (pointer, integer)
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3306 void *pointer;
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3307 int integer;
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3308 {
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3309 register Lisp_Object val;
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3310 register struct Lisp_Save_Value *p;
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3311
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3312 val = allocate_misc ();
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3313 XMISCTYPE (val) = Lisp_Misc_Save_Value;
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3314 p = XSAVE_VALUE (val);
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3315 p->pointer = pointer;
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3316 p->integer = integer;
56202
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
3317 p->dogc = 0;
49055
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3318 return val;
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3319 }
cea2e52c7ca5 (make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents: 48907
diff changeset
3320
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3321 DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
3322 doc: /* Return a newly allocated marker which does not point at any place. */)
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3323 ()
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3324 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3325 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3326 register struct Lisp_Marker *p;
638
40b255f55df3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 624
diff changeset
3327
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
3328 val = allocate_misc ();
11243
054ecfce1820 (Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11048
diff changeset
3329 XMISCTYPE (val) = Lisp_Misc_Marker;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3330 p = XMARKER (val);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3331 p->buffer = 0;
20565
aa9b7c5f0f62 (Fmake_marker): Initialize marker's bytepos and charpos.
Richard M. Stallman <rms@gnu.org>
parents: 20495
diff changeset
3332 p->bytepos = 0;
aa9b7c5f0f62 (Fmake_marker): Initialize marker's bytepos and charpos.
Richard M. Stallman <rms@gnu.org>
parents: 20495
diff changeset
3333 p->charpos = 0;
51668
0f333fd92a1d (survives_gc_p): Simplify.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51658
diff changeset
3334 p->next = NULL;
13008
f042ef632b22 (Fmake_marker): Initialize insertion_type to 0.
Richard M. Stallman <rms@gnu.org>
parents: 12748
diff changeset
3335 p->insertion_type = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3336 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3337 }
19332
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
3338
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
3339 /* 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
3340
20375
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
3341 void
19332
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
3342 free_marker (marker)
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
3343 Lisp_Object marker;
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
3344 {
51668
0f333fd92a1d (survives_gc_p): Simplify.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51658
diff changeset
3345 unchain_marker (XMARKER (marker));
56239
a446552d2240 (allocate_misc): Update total_free_markers.
Kim F. Storm <storm@cua.dk>
parents: 56202
diff changeset
3346 free_misc (marker);
19332
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
3347 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3348
21258
693573ac0944 (make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
3349
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3350 /* 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
3351 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
3352 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
3353
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
3354 Any number of arguments, even zero arguments, are allowed. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3355
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3356 Lisp_Object
2013
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
3357 make_event_array (nargs, args)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3358 register int nargs;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3359 Lisp_Object *args;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3360 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3361 int i;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3362
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3363 for (i = 0; i < nargs; i++)
2013
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
3364 /* 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
3365 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
3366 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
3367 if (!INTEGERP (args[i])
3536
58d5ee6ec253 (make_event_array): Ignore bits above CHAR_META.
Richard M. Stallman <rms@gnu.org>
parents: 3181
diff changeset
3368 || (XUINT (args[i]) & ~(-CHAR_META)) >= 0200)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3369 return Fvector (nargs, args);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3370
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3371 /* Since the loop exited, we know that all the things in it are
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3372 characters, so we can make a string. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3373 {
6492
8372dce85f8a (make_event_array): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
parents: 6227
diff changeset
3374 Lisp_Object result;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3375
18104
b2a669ef69b1 (Fmake_byte_code): Set val from p, not from val.
Richard M. Stallman <rms@gnu.org>
parents: 18010
diff changeset
3376 result = Fmake_string (make_number (nargs), make_number (0));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3377 for (i = 0; i < nargs; i++)
2013
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
3378 {
46418
b12a32662433 * alloc.c (make_event_array): Use SSET for storing into a string.
Ken Raeburn <raeburn@raeburn.org>
parents: 46370
diff changeset
3379 SSET (result, i, XINT (args[i]));
2013
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
3380 /* 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
3381 if (XINT (args[i]) & CHAR_META)
46418
b12a32662433 * alloc.c (make_event_array): Use SSET for storing into a string.
Ken Raeburn <raeburn@raeburn.org>
parents: 46370
diff changeset
3382 SSET (result, i, SREF (result, i) | 0x80);
2013
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
3383 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3384
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3385 return result;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3386 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3387 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3388
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3389
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3390
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3391 /************************************************************************
66530
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3392 Memory Full Handling
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3393 ************************************************************************/
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3394
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3395
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3396 /* Called if malloc returns zero. */
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3397
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3398 void
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3399 memory_full ()
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3400 {
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3401 int i;
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3402
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3403 Vmemory_full = Qt;
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3404
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3405 memory_full_cons_threshold = sizeof (struct cons_block);
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3406
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3407 /* The first time we get here, free the spare memory. */
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3408 for (i = 0; i < sizeof (spare_memory) / sizeof (char *); i++)
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3409 if (spare_memory[i])
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3410 {
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3411 if (i == 0)
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3412 free (spare_memory[i]);
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3413 else if (i >= 1 && i <= 4)
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3414 lisp_align_free (spare_memory[i]);
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3415 else
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3416 lisp_free (spare_memory[i]);
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3417 spare_memory[i] = 0;
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3418 }
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3419
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3420 /* Record the space now used. When it decreases substantially,
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3421 we can refill the memory reserve. */
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3422 #ifndef SYSTEM_MALLOC
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3423 bytes_used_when_full = BYTES_USED;
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3424 #endif
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3425
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3426 /* This used to call error, but if we've run out of memory, we could
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3427 get infinite recursion trying to build the string. */
71967
3254b987edcb (buffer_memory_full, memory_full): Use xsignal. Remove loop.
Kim F. Storm <storm@cua.dk>
parents: 69876
diff changeset
3428 xsignal (Qnil, Vmemory_signal_data);
66530
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3429 }
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3430
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3431 /* If we released our reserve (due to running out of memory),
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3432 and we have a fair amount free once again,
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3433 try to set aside another reserve in case we run out once more.
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3434
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3435 This is called when a relocatable block is freed in ralloc.c,
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3436 and also directly from this file, in case we're not using ralloc.c. */
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3437
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3438 void
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3439 refill_memory_reserve ()
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3440 {
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3441 #ifndef SYSTEM_MALLOC
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3442 if (spare_memory[0] == 0)
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3443 spare_memory[0] = (char *) malloc ((size_t) SPARE_MEMORY);
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3444 if (spare_memory[1] == 0)
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3445 spare_memory[1] = (char *) lisp_align_malloc (sizeof (struct cons_block),
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3446 MEM_TYPE_CONS);
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3447 if (spare_memory[2] == 0)
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3448 spare_memory[2] = (char *) lisp_align_malloc (sizeof (struct cons_block),
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3449 MEM_TYPE_CONS);
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3450 if (spare_memory[3] == 0)
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3451 spare_memory[3] = (char *) lisp_align_malloc (sizeof (struct cons_block),
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3452 MEM_TYPE_CONS);
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3453 if (spare_memory[4] == 0)
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3454 spare_memory[4] = (char *) lisp_align_malloc (sizeof (struct cons_block),
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3455 MEM_TYPE_CONS);
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3456 if (spare_memory[5] == 0)
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3457 spare_memory[5] = (char *) lisp_malloc (sizeof (struct string_block),
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3458 MEM_TYPE_STRING);
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3459 if (spare_memory[6] == 0)
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3460 spare_memory[6] = (char *) lisp_malloc (sizeof (struct string_block),
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3461 MEM_TYPE_STRING);
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3462 if (spare_memory[0] && spare_memory[1] && spare_memory[5])
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3463 Vmemory_full = Qnil;
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3464 #endif
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3465 }
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3466
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
3467 /************************************************************************
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3468 C Stack Marking
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3469 ************************************************************************/
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3470
32700
25c6c2562e31 (toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents: 32699
diff changeset
3471 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
25c6c2562e31 (toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents: 32699
diff changeset
3472
42403
6643f205d5db Add a comment.
Gerd Moellmann <gerd@gnu.org>
parents: 42096
diff changeset
3473 /* Conservative C stack marking requires a method to identify possibly
6643f205d5db Add a comment.
Gerd Moellmann <gerd@gnu.org>
parents: 42096
diff changeset
3474 live Lisp objects given a pointer value. We do this by keeping
6643f205d5db Add a comment.
Gerd Moellmann <gerd@gnu.org>
parents: 42096
diff changeset
3475 track of blocks of Lisp data that are allocated in a red-black tree
6643f205d5db Add a comment.
Gerd Moellmann <gerd@gnu.org>
parents: 42096
diff changeset
3476 (see also the comment of mem_node which is the type of nodes in
6643f205d5db Add a comment.
Gerd Moellmann <gerd@gnu.org>
parents: 42096
diff changeset
3477 that tree). Function lisp_malloc adds information for an allocated
6643f205d5db Add a comment.
Gerd Moellmann <gerd@gnu.org>
parents: 42096
diff changeset
3478 block to the red-black tree with calls to mem_insert, and function
6643f205d5db Add a comment.
Gerd Moellmann <gerd@gnu.org>
parents: 42096
diff changeset
3479 lisp_free removes it with mem_delete. Functions live_string_p etc
6643f205d5db Add a comment.
Gerd Moellmann <gerd@gnu.org>
parents: 42096
diff changeset
3480 call mem_find to lookup information about a given pointer in the
6643f205d5db Add a comment.
Gerd Moellmann <gerd@gnu.org>
parents: 42096
diff changeset
3481 tree, and use that to determine if the pointer points to a Lisp
6643f205d5db Add a comment.
Gerd Moellmann <gerd@gnu.org>
parents: 42096
diff changeset
3482 object or not. */
6643f205d5db Add a comment.
Gerd Moellmann <gerd@gnu.org>
parents: 42096
diff changeset
3483
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3484 /* 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
3485
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3486 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3487 mem_init ()
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3488 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3489 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
3490 mem_z.parent = NULL;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3491 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
3492 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
3493 mem_root = MEM_NIL;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3494 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3495
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3496
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3497 /* 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
3498 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
3499
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3500 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
3501 mem_find (start)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3502 void *start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3503 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3504 struct mem_node *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3505
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3506 if (start < min_heap_address || start > max_heap_address)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3507 return MEM_NIL;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3508
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3509 /* 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
3510 mem_z.start = start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3511 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
3512
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3513 p = mem_root;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3514 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
3515 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
3516 return p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3517 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3518
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 /* 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
3521 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
3522 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
3523
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3524 static struct mem_node *
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3525 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
3526 void *start, *end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3527 enum mem_type type;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3528 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3529 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
3530
77260
a6fbfb6a0580 (mem_insert): Set min_heap_address and max_heap_address
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 75406
diff changeset
3531 if (min_heap_address == NULL || start < min_heap_address)
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3532 min_heap_address = start;
77260
a6fbfb6a0580 (mem_insert): Set min_heap_address and max_heap_address
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 75406
diff changeset
3533 if (max_heap_address == NULL || end > max_heap_address)
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3534 max_heap_address = end;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3535
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3536 /* 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
3537 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
3538 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
3539 c = mem_root;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3540 parent = NULL;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3541
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3542 #if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3543
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3544 while (c != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3545 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3546 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
3547 abort ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3548 parent = c;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3549 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
3550 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3551
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3552 #else /* GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS */
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3553
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3554 while (c != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3555 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3556 parent = c;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3557 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
3558 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3559
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3560 #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
3561
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3562 /* Create a new node. */
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3563 #ifdef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3564 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
3565 if (x == NULL)
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3566 abort ();
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3567 #else
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3568 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
3569 #endif
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3570 x->start = start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3571 x->end = end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3572 x->type = type;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3573 x->parent = parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3574 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
3575 x->color = MEM_RED;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3576
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3577 /* 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
3578 if (parent)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3579 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3580 if (start < parent->start)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3581 parent->left = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3582 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3583 parent->right = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3584 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3585 else
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3586 mem_root = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3587
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3588 /* 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
3589 mem_insert_fixup (x);
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3590
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3591 return x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3592 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3593
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3594
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3595 /* 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
3596 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
3597
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3598 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3599 mem_insert_fixup (x)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3600 struct mem_node *x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3601 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3602 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
3603 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3604 /* 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
3605 red-black tree property #3. */
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3606
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3607 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
3608 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3609 /* 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
3610 "uncle". */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3611 struct mem_node *y = x->parent->parent->right;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3612
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3613 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
3614 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3615 /* 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
3616 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
3617 with the grandparent. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3618 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
3619 y->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3620 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
3621 x = x->parent->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3622 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3623 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3624 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3625 /* 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
3626 red, uncle is black. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3627 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
3628 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3629 x = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3630 mem_rotate_left (x);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3631 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3632
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3633 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
3634 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
3635 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
3636 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3637 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3638 else
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 /* 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
3641 struct mem_node *y = x->parent->parent->left;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3642
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3643 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
3644 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3645 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
3646 y->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3647 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
3648 x = x->parent->parent;
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 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3651 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3652 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
3653 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3654 x = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3655 mem_rotate_right (x);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3656 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3657
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3658 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
3659 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
3660 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
3661 }
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 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3664
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3665 /* 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
3666 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
3667 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
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
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3671 /* (x) (y)
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3672 / \ / \
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3673 a (y) ===> (x) c
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3674 / \ / \
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3675 b c a b */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3676
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3677 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3678 mem_rotate_left (x)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3679 struct mem_node *x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3680 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3681 struct mem_node *y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3682
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3683 /* 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
3684 y = x->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3685 x->right = y->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3686 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
3687 y->left->parent = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3688
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3689 /* 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
3690 if (y != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3691 y->parent = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3692
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3693 /* 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
3694 if (x->parent)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3695 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3696 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
3697 x->parent->left = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3698 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3699 x->parent->right = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3700 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3701 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3702 mem_root = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3703
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3704 /* 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
3705 y->left = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3706 if (x != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3707 x->parent = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3708 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3709
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3710
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3711 /* (x) (Y)
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3712 / \ / \
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3713 (y) c ===> a (x)
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3714 / \ / \
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3715 a b b c */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3716
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3717 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3718 mem_rotate_right (x)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3719 struct mem_node *x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3720 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3721 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
3722
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3723 x->left = y->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3724 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
3725 y->right->parent = x;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3726
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3727 if (y != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3728 y->parent = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3729 if (x->parent)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3730 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3731 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
3732 x->parent->right = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3733 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3734 x->parent->left = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3735 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3736 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3737 mem_root = y;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3738
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3739 y->right = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3740 if (x != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3741 x->parent = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3742 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3743
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3744
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3745 /* 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
3746
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3747 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3748 mem_delete (z)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3749 struct mem_node *z;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3750 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3751 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
3752
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3753 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
3754 return;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3755
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3756 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
3757 y = z;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3758 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3759 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3760 y = z->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3761 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
3762 y = y->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3763 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3764
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3765 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
3766 x = y->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3767 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3768 x = y->right;
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 x->parent = y->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3771 if (y->parent)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3772 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3773 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
3774 y->parent->left = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3775 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3776 y->parent->right = x;
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 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3779 mem_root = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3780
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3781 if (y != z)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3782 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3783 z->start = y->start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3784 z->end = y->end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3785 z->type = y->type;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3786 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3787
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3788 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
3789 mem_delete_fixup (x);
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3790
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3791 #ifdef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3792 _free_internal (y);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3793 #else
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3794 xfree (y);
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3795 #endif
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3796 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3797
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3798
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3799 /* 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
3800 deletion. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3801
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3802 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3803 mem_delete_fixup (x)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3804 struct mem_node *x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3805 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3806 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
3807 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3808 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
3809 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3810 struct mem_node *w = x->parent->right;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3811
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3812 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
3813 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3814 w->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3815 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
3816 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
3817 w = x->parent->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3818 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3819
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3820 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
3821 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3822 w->color = MEM_RED;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3823 x = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3824 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3825 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3826 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3827 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
3828 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3829 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
3830 w->color = MEM_RED;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3831 mem_rotate_right (w);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3832 w = x->parent->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3833 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3834 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
3835 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
3836 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
3837 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
3838 x = mem_root;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3839 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3840 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3841 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3842 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3843 struct mem_node *w = x->parent->left;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3844
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3845 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
3846 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3847 w->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3848 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
3849 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
3850 w = x->parent->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3851 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3852
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3853 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
3854 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3855 w->color = MEM_RED;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3856 x = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3857 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3858 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3859 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3860 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
3861 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3862 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
3863 w->color = MEM_RED;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3864 mem_rotate_left (w);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3865 w = x->parent->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3866 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
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 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
3869 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
3870 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
3871 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
3872 x = mem_root;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3873 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3874 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3875 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3876
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3877 x->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3878 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3879
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3880
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3881 /* 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
3882 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
3883
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3884 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3885 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
3886 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3887 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3888 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3889 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
3890 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3891 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
3892 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
3893
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3894 /* 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
3895 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
3896 return (offset >= 0
184d1fb71cc1 (live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents: 36487
diff changeset
3897 && offset % sizeof b->strings[0] == 0
53582
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
3898 && offset < (STRING_BLOCK_SIZE * sizeof b->strings[0])
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3899 && ((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
3900 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3901 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3902 return 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3903 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3904
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3905
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3906 /* 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
3907 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
3908
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3909 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3910 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
3911 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3912 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3913 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3914 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
3915 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3916 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
3917 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
3918
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3919 /* 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
3920 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
3921 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
3922 return (offset >= 0
53582
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
3923 && offset % sizeof b->conses[0] == 0
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
3924 && offset < (CONS_BLOCK_SIZE * sizeof b->conses[0])
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3925 && (b != cons_block
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3926 || 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
3927 && !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
3928 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3929 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3930 return 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3931 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3932
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3933
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3934 /* 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
3935 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
3936
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3937 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3938 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
3939 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3940 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3941 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3942 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
3943 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3944 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
3945 int offset = (char *) p - (char *) &b->symbols[0];
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3946
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3947 /* 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
3948 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
3949 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
3950 return (offset >= 0
184d1fb71cc1 (live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents: 36487
diff changeset
3951 && offset % sizeof b->symbols[0] == 0
53582
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
3952 && offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0])
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3953 && (b != symbol_block
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3954 || 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
3955 && !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
3956 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3957 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3958 return 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3959 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3960
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3961
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3962 /* 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
3963 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
3964
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3965 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3966 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
3967 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3968 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3969 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3970 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
3971 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3972 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
3973 int offset = (char *) p - (char *) &b->floats[0];
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
3974
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
3975 /* P must point to the start of a Lisp_Float and not be
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
3976 one of the unused cells in the current float block. */
37049
184d1fb71cc1 (live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents: 36487
diff changeset
3977 return (offset >= 0
53582
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
3978 && offset % sizeof b->floats[0] == 0
51779
f01acdb936f9 (live_float_p): Check that p is not past the `floats' array,
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51770
diff changeset
3979 && offset < (FLOAT_BLOCK_SIZE * sizeof b->floats[0])
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3980 && (b != float_block
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
3981 || offset / sizeof b->floats[0] < float_block_index));
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3982 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3983 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3984 return 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3985 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3986
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3987
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3988 /* 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
3989 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
3990
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3991 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3992 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
3993 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3994 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3995 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3996 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
3997 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3998 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
3999 int offset = (char *) p - (char *) &b->markers[0];
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4000
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4001 /* 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
4002 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
4003 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
4004 return (offset >= 0
184d1fb71cc1 (live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents: 36487
diff changeset
4005 && offset % sizeof b->markers[0] == 0
53582
b4eef5adebbf (struct interval_block, struct string_block)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53555
diff changeset
4006 && offset < (MARKER_BLOCK_SIZE * sizeof b->markers[0])
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4007 && (b != marker_block
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4008 || offset / sizeof b->markers[0] < marker_block_index)
85344
99492f857499 (free_misc): Use XMISCTYPE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85329
diff changeset
4009 && ((union Lisp_Misc *) p)->u_any.type != Lisp_Misc_Free);
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4010 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4011 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4012 return 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4013 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4014
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4015
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4016 /* 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
4017 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
4018
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4019 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4020 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
4021 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4022 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4023 {
84978
33b7fe948502 (enum mem_type): Replace all vector subtypes -> MEM_TYPE_VECTORLIKE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84977
diff changeset
4024 return (p == m->start && m->type == MEM_TYPE_VECTORLIKE);
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4025 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4026
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4027
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
4028 /* Value is non-zero if P is a pointer to a live buffer. M is a
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4029 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
4030
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4031 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4032 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
4033 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4034 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4035 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4036 /* 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
4037 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
4038 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
4039 && p == m->start
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4040 && !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
4041 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4042
32700
25c6c2562e31 (toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents: 32699
diff changeset
4043 #endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */
25c6c2562e31 (toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents: 32699
diff changeset
4044
25c6c2562e31 (toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents: 32699
diff changeset
4045 #if GC_MARK_STACK
25c6c2562e31 (toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents: 32699
diff changeset
4046
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4047 #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
4048
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4049 /* 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
4050 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
4051
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4052 #define MAX_ZOMBIES 10
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4053 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
4054
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4055 /* Number of zombie objects. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4056
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4057 static int nzombies;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4058
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4059 /* Number of garbage collections. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4060
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4061 static int ngcs;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4062
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4063 /* 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
4064
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4065 static double avg_zombies;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4066
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4067 /* 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
4068
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4069 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
4070
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4071 /* 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
4072
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4073 static double avg_live;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4074
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4075 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
4076 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
4077 ()
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4078 {
49357
90e4c5eeb9a0 (Fgc_status): Print zombie list.
Dave Love <fx@gnu.org>
parents: 49322
diff changeset
4079 Lisp_Object args[8], zombie_list = Qnil;
90e4c5eeb9a0 (Fgc_status): Print zombie list.
Dave Love <fx@gnu.org>
parents: 49322
diff changeset
4080 int i;
90e4c5eeb9a0 (Fgc_status): Print zombie list.
Dave Love <fx@gnu.org>
parents: 49322
diff changeset
4081 for (i = 0; i < nzombies; i++)
90e4c5eeb9a0 (Fgc_status): Print zombie list.
Dave Love <fx@gnu.org>
parents: 49322
diff changeset
4082 zombie_list = Fcons (zombies[i], zombie_list);
90e4c5eeb9a0 (Fgc_status): Print zombie list.
Dave Love <fx@gnu.org>
parents: 49322
diff changeset
4083 args[0] = build_string ("%d GCs, avg live/zombies = %.2f/%.2f (%f%%), max %d/%d\nzombies: %S");
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4084 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
4085 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
4086 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
4087 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
4088 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
4089 args[6] = make_number (max_zombies);
49357
90e4c5eeb9a0 (Fgc_status): Print zombie list.
Dave Love <fx@gnu.org>
parents: 49322
diff changeset
4090 args[7] = zombie_list;
90e4c5eeb9a0 (Fgc_status): Print zombie list.
Dave Love <fx@gnu.org>
parents: 49322
diff changeset
4091 return Fmessage (8, args);
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4092 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4093
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4094 #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
4095
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4096
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4097 /* 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
4098
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4099 static INLINE void
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4100 mark_maybe_object (obj)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4101 Lisp_Object obj;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4102 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4103 void *po = (void *) XPNTR (obj);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4104 struct mem_node *m = mem_find (po);
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4105
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4106 if (m != MEM_NIL)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4107 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4108 int mark_p = 0;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4109
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
4110 switch (XTYPE (obj))
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4111 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4112 case Lisp_String:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4113 mark_p = (live_string_p (m, po)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4114 && !STRING_MARKED_P ((struct Lisp_String *) po));
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4115 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4116
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4117 case Lisp_Cons:
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
4118 mark_p = (live_cons_p (m, po) && !CONS_MARKED_P (XCONS (obj)));
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4119 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4120
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4121 case Lisp_Symbol:
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
4122 mark_p = (live_symbol_p (m, po) && !XSYMBOL (obj)->gcmarkbit);
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4123 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4124
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4125 case Lisp_Float:
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
4126 mark_p = (live_float_p (m, po) && !FLOAT_MARKED_P (XFLOAT (obj)));
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4127 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4128
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4129 case Lisp_Vectorlike:
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
4130 /* Note: can't check BUFFERP before we know it's a
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4131 buffer because checking that dereferences the pointer
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4132 PO which might point anywhere. */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4133 if (live_vector_p (m, po))
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
4134 mark_p = !SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj));
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4135 else if (live_buffer_p (m, po))
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
4136 mark_p = BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj));
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4137 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4138
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4139 case Lisp_Misc:
85328
d0d527210b0c * lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85023
diff changeset
4140 mark_p = (live_misc_p (m, po) && !XMISCANY (obj)->gcmarkbit);
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4141 break;
31829
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
4142
105885
8103235103a7 Let integers use up 2 tags to give them one extra bit and double their range.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105881
diff changeset
4143 default:
31829
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
4144 break;
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4145 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4146
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4147 if (mark_p)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4148 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4149 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4150 if (nzombies < MAX_ZOMBIES)
49357
90e4c5eeb9a0 (Fgc_status): Print zombie list.
Dave Love <fx@gnu.org>
parents: 49322
diff changeset
4151 zombies[nzombies] = obj;
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4152 ++nzombies;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4153 #endif
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
4154 mark_object (obj);
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4155 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4156 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4157 }
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4158
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4159
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4160 /* 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
4161 marked. */
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4162
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4163 static INLINE void
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4164 mark_maybe_pointer (p)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4165 void *p;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4166 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4167 struct mem_node *m;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4168
81798
3b39669cb653 (mark_maybe_pointer): Enforce mult-of-8 alignment when using
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81272
diff changeset
4169 /* Quickly rule out some values which can't point to Lisp data. */
3b39669cb653 (mark_maybe_pointer): Enforce mult-of-8 alignment when using
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81272
diff changeset
4170 if ((EMACS_INT) p %
3b39669cb653 (mark_maybe_pointer): Enforce mult-of-8 alignment when using
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81272
diff changeset
4171 #ifdef USE_LSB_TAG
3b39669cb653 (mark_maybe_pointer): Enforce mult-of-8 alignment when using
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81272
diff changeset
4172 8 /* USE_LSB_TAG needs Lisp data to be aligned on multiples of 8. */
3b39669cb653 (mark_maybe_pointer): Enforce mult-of-8 alignment when using
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81272
diff changeset
4173 #else
3b39669cb653 (mark_maybe_pointer): Enforce mult-of-8 alignment when using
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81272
diff changeset
4174 2 /* We assume that Lisp data is aligned on even addresses. */
3b39669cb653 (mark_maybe_pointer): Enforce mult-of-8 alignment when using
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81272
diff changeset
4175 #endif
3b39669cb653 (mark_maybe_pointer): Enforce mult-of-8 alignment when using
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81272
diff changeset
4176 )
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4177 return;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4178
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4179 m = mem_find (p);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4180 if (m != MEM_NIL)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4181 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4182 Lisp_Object obj = Qnil;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4183
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4184 switch (m->type)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4185 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4186 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
4187 /* Nothing to do; not a pointer to Lisp memory. */
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4188 break;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4189
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4190 case MEM_TYPE_BUFFER:
51683
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
4191 if (live_buffer_p (m, p) && !VECTOR_MARKED_P((struct buffer *)p))
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4192 XSETVECTOR (obj, p);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4193 break;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4194
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4195 case MEM_TYPE_CONS:
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
4196 if (live_cons_p (m, p) && !CONS_MARKED_P ((struct Lisp_Cons *) p))
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4197 XSETCONS (obj, p);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4198 break;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4199
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4200 case MEM_TYPE_STRING:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4201 if (live_string_p (m, p)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4202 && !STRING_MARKED_P ((struct Lisp_String *) p))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4203 XSETSTRING (obj, p);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4204 break;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4205
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4206 case MEM_TYPE_MISC:
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
4207 if (live_misc_p (m, p) && !((struct Lisp_Free *) p)->gcmarkbit)
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
4208 XSETMISC (obj, p);
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4209 break;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4210
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4211 case MEM_TYPE_SYMBOL:
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
4212 if (live_symbol_p (m, p) && !((struct Lisp_Symbol *) p)->gcmarkbit)
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4213 XSETSYMBOL (obj, p);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4214 break;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4215
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4216 case MEM_TYPE_FLOAT:
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
4217 if (live_float_p (m, p) && !FLOAT_MARKED_P (p))
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4218 XSETFLOAT (obj, p);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4219 break;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4220
84978
33b7fe948502 (enum mem_type): Replace all vector subtypes -> MEM_TYPE_VECTORLIKE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84977
diff changeset
4221 case MEM_TYPE_VECTORLIKE:
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4222 if (live_vector_p (m, p))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4223 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4224 Lisp_Object tem;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4225 XSETVECTOR (tem, p);
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
4226 if (!SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem)))
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4227 obj = tem;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4228 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4229 break;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4230
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4231 default:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4232 abort ();
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4233 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4234
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
4235 if (!NILP (obj))
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
4236 mark_object (obj);
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4237 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4238 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4239
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4240
73964
b684c6771753 (mark_memory): New argument OFFSET. All uses changed.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72537
diff changeset
4241 /* Mark Lisp objects referenced from the address range START+OFFSET..END
b684c6771753 (mark_memory): New argument OFFSET. All uses changed.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72537
diff changeset
4242 or END+OFFSET..START. */
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4243
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4244 static void
73964
b684c6771753 (mark_memory): New argument OFFSET. All uses changed.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72537
diff changeset
4245 mark_memory (start, end, offset)
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4246 void *start, *end;
73964
b684c6771753 (mark_memory): New argument OFFSET. All uses changed.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72537
diff changeset
4247 int offset;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4248 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4249 Lisp_Object *p;
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4250 void **pp;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4251
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4252 #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
4253 nzombies = 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4254 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4255
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4256 /* 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
4257 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
4258 if (end < start)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4259 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4260 void *tem = start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4261 start = end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4262 end = tem;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4263 }
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4264
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4265 /* Mark Lisp_Objects. */
73964
b684c6771753 (mark_memory): New argument OFFSET. All uses changed.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72537
diff changeset
4266 for (p = (Lisp_Object *) ((char *) start + offset); (void *) p < end; ++p)
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4267 mark_maybe_object (*p);
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4268
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4269 /* 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
4270 situations, the C compiler optimizes Lisp objects away, so that
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4271 only a pointer to them remains. Example:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4272
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4273 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
4274 ()
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4275 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4276 Lisp_Object obj = build_string ("test");
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4277 struct Lisp_String *s = XSTRING (obj);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4278 Fgarbage_collect ();
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4279 fprintf (stderr, "test `%s'\n", s->data);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4280 return Qnil;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4281 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4282
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4283 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
4284 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
4285 pointer `s'. */
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4286
73964
b684c6771753 (mark_memory): New argument OFFSET. All uses changed.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72537
diff changeset
4287 for (pp = (void **) ((char *) start + offset); (void *) pp < end; ++pp)
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
4288 mark_maybe_pointer (*pp);
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4289 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4290
48316
043dddbc037a (SETJMP_WILL_NOT_WORK): Add note.
Dave Love <fx@gnu.org>
parents: 47391
diff changeset
4291 /* setjmp will work with GCC unless NON_SAVING_SETJMP is defined in
043dddbc037a (SETJMP_WILL_NOT_WORK): Add note.
Dave Love <fx@gnu.org>
parents: 47391
diff changeset
4292 the GCC system configuration. In gcc 3.2, the only systems for
043dddbc037a (SETJMP_WILL_NOT_WORK): Add note.
Dave Love <fx@gnu.org>
parents: 47391
diff changeset
4293 which this is so are i386-sco5 non-ELF, i386-sysv3 (maybe included
043dddbc037a (SETJMP_WILL_NOT_WORK): Add note.
Dave Love <fx@gnu.org>
parents: 47391
diff changeset
4294 by others?) and ns32k-pc532-min. */
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4295
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4296 #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
4297
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4298 static int setjmp_tested_p, longjmps_done;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4299
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4300 #define SETJMP_WILL_LIKELY_WORK "\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4301 \n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4302 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
4303 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
4304 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
4305 \n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4306 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
4307 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
4308 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
4309 \n\
43200
4082674ce69b (SETJMP_WILL_LIKELY_WORK, SETJMP_WILL_NOT_WORK):
Kim F. Storm <storm@cua.dk>
parents: 43161
diff changeset
4310 Please mail the result to <emacs-devel@gnu.org>.\n\
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4311 "
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4312
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4313 #define SETJMP_WILL_NOT_WORK "\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4314 \n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4315 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
4316 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
4317 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
4318 solution for your system.\n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4319 \n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4320 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
4321 try to find a way to make it work on your system.\n\
48316
043dddbc037a (SETJMP_WILL_NOT_WORK): Add note.
Dave Love <fx@gnu.org>
parents: 47391
diff changeset
4322 \n\
043dddbc037a (SETJMP_WILL_NOT_WORK): Add note.
Dave Love <fx@gnu.org>
parents: 47391
diff changeset
4323 Note that you may get false negatives, depending on the compiler.\n\
043dddbc037a (SETJMP_WILL_NOT_WORK): Add note.
Dave Love <fx@gnu.org>
parents: 47391
diff changeset
4324 In particular, you need to use -O with GCC for this test.\n\
043dddbc037a (SETJMP_WILL_NOT_WORK): Add note.
Dave Love <fx@gnu.org>
parents: 47391
diff changeset
4325 \n\
43200
4082674ce69b (SETJMP_WILL_LIKELY_WORK, SETJMP_WILL_NOT_WORK):
Kim F. Storm <storm@cua.dk>
parents: 43161
diff changeset
4326 Please mail the result to <emacs-devel@gnu.org>.\n\
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4327 "
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4328
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4329
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4330 /* 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
4331 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
4332 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
4333 conservative stack marking. Only the sources or a disassembly
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4334 can prove that. */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4335
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4336 static void
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4337 test_setjmp ()
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4338 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4339 char buf[10];
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4340 register int x;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4341 jmp_buf jbuf;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4342 int result = 0;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4343
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4344 /* Arrange for X to be put in a register. */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4345 sprintf (buf, "1");
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4346 x = strlen (buf);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4347 x = 2 * x - 1;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4348
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4349 setjmp (jbuf);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4350 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
4351 {
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4352 /* 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
4353
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4354 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
4355 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
4356 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
4357 isn't sure.
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4358
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4359 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
4360 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
4361
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4362 if (x == 1)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4363 fprintf (stderr, SETJMP_WILL_LIKELY_WORK);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4364 else
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4365 {
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4366 fprintf (stderr, SETJMP_WILL_NOT_WORK);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4367 exit (1);
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4368 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4369 }
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4370
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4371 ++longjmps_done;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4372 x = 2;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4373 if (longjmps_done == 1)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4374 longjmp (jbuf, 1);
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4375 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4376
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4377 #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
4378
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4379
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4380 #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
4381
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4382 /* 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
4383
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4384 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4385 check_gcpros ()
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4386 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4387 struct gcpro *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4388 int i;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4389
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4390 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
4391 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
4392 if (!survives_gc_p (p->var[i]))
50626
a5a77c7717cb (Fmake_byte_code): Improve the `usage' string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50468
diff changeset
4393 /* FIXME: It's not necessarily a bug. It might just be that the
a5a77c7717cb (Fmake_byte_code): Improve the `usage' string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50468
diff changeset
4394 GCPRO is unnecessary or should release the object sooner. */
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4395 abort ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4396 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4397
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4398 #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
4399
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4400 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4401 dump_zombies ()
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4402 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4403 int i;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4404
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4405 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
4406 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
4407 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4408 fprintf (stderr, " %d = ", i);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4409 debug_print (zombies[i]);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4410 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4411 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4412
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4413 #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
4414
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4415
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4416 /* Mark live Lisp objects on the C stack.
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4417
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4418 There are several system-dependent problems to consider when
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4419 porting this to new architectures:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4420
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4421 Processor Registers
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4422
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4423 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
4424 variables or are used to pass parameters.
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4425
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4426 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
4427 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
4428 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
4429
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4430 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
4431 implementation assumes that calling setjmp saves registers we need
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4432 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
4433 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
4434 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
4435
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4436 Stack Layout
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4437
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4438 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
4439 For example, the stack might look like this
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4440
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4441 +----------------+
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4442 | Lisp_Object | size = 4
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4443 +----------------+
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4444 | something else | size = 2
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4445 +----------------+
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4446 | Lisp_Object | size = 4
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4447 +----------------+
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4448 | ... |
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4449
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4450 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
4451 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
4452 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
4453 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
4454 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
4455 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
4456 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
4457 from the stack start.
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4458
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4459 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
4460 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
4461
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4462 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4463 mark_stack ()
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4464 {
43160
630c8b6deafd (mark_stack): Don't assume sizeof (Lisp_Object) is 4.
Andreas Schwab <schwab@suse.de>
parents: 43005
diff changeset
4465 int i;
73964
b684c6771753 (mark_memory): New argument OFFSET. All uses changed.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72537
diff changeset
4466 /* jmp_buf may not be aligned enough on darwin-ppc64 */
b684c6771753 (mark_memory): New argument OFFSET. All uses changed.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72537
diff changeset
4467 union aligned_jmpbuf {
b684c6771753 (mark_memory): New argument OFFSET. All uses changed.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72537
diff changeset
4468 Lisp_Object o;
b684c6771753 (mark_memory): New argument OFFSET. All uses changed.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72537
diff changeset
4469 jmp_buf j;
b684c6771753 (mark_memory): New argument OFFSET. All uses changed.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72537
diff changeset
4470 } j;
31829
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
4471 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
4472 void *end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4473
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4474 /* 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
4475 the process is contained in the stack. */
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
4476 /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is
49414
668c96afa702 (mark_stack) [!GC_LISP_OBJECT_ALIGNMENT && __GNUC__]:
Dave Love <fx@gnu.org>
parents: 49357
diff changeset
4477 needed on ia64 too. See mach_dep.c, where it also says inline
668c96afa702 (mark_stack) [!GC_LISP_OBJECT_ALIGNMENT && __GNUC__]:
Dave Love <fx@gnu.org>
parents: 49357
diff changeset
4478 assembler doesn't work with relevant proprietary compilers. */
96545
4cb0e945175d Use __sparc__ rather than sparc. (Bug#507.)
Glenn Morris <rgm@gnu.org>
parents: 95481
diff changeset
4479 #ifdef __sparc__
101689
697627d7beda (mark_stack): Properly conditionalize previous change.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 101387
diff changeset
4480 #if defined (__sparc64__) && defined (__FreeBSD__)
697627d7beda (mark_stack): Properly conditionalize previous change.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 101387
diff changeset
4481 /* FreeBSD does not have a ta 3 handler. */
101387
b19b16732fb0 (mark_stack): Use "flushw" instead of "ta 3" assembly call for
Chong Yidong <cyd@stupidchicken.com>
parents: 100951
diff changeset
4482 asm ("flushw");
b19b16732fb0 (mark_stack): Use "flushw" instead of "ta 3" assembly call for
Chong Yidong <cyd@stupidchicken.com>
parents: 100951
diff changeset
4483 #else
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4484 asm ("ta 3");
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4485 #endif
101387
b19b16732fb0 (mark_stack): Use "flushw" instead of "ta 3" assembly call for
Chong Yidong <cyd@stupidchicken.com>
parents: 100951
diff changeset
4486 #endif
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4487
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4488 /* 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
4489 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
4490 pass parameters. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4491 #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
4492 GC_SAVE_REGISTERS_ON_STACK (end);
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4493 #else /* not GC_SAVE_REGISTERS_ON_STACK */
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4494
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4495 #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
4496 setjmp will definitely work, test it
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4497 and print a message with the result
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4498 of the test. */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4499 if (!setjmp_tested_p)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4500 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4501 setjmp_tested_p = 1;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4502 test_setjmp ();
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4503 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4504 #endif /* GC_SETJMP_WORKS */
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
4505
73964
b684c6771753 (mark_memory): New argument OFFSET. All uses changed.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72537
diff changeset
4506 setjmp (j.j);
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4507 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
4508 #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
4509
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4510 /* 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
4511 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
4512 over the stack segments. */
43160
630c8b6deafd (mark_stack): Don't assume sizeof (Lisp_Object) is 4.
Andreas Schwab <schwab@suse.de>
parents: 43005
diff changeset
4513 #ifndef GC_LISP_OBJECT_ALIGNMENT
49414
668c96afa702 (mark_stack) [!GC_LISP_OBJECT_ALIGNMENT && __GNUC__]:
Dave Love <fx@gnu.org>
parents: 49357
diff changeset
4514 #ifdef __GNUC__
668c96afa702 (mark_stack) [!GC_LISP_OBJECT_ALIGNMENT && __GNUC__]:
Dave Love <fx@gnu.org>
parents: 49357
diff changeset
4515 #define GC_LISP_OBJECT_ALIGNMENT __alignof__ (Lisp_Object)
668c96afa702 (mark_stack) [!GC_LISP_OBJECT_ALIGNMENT && __GNUC__]:
Dave Love <fx@gnu.org>
parents: 49357
diff changeset
4516 #else
43160
630c8b6deafd (mark_stack): Don't assume sizeof (Lisp_Object) is 4.
Andreas Schwab <schwab@suse.de>
parents: 43005
diff changeset
4517 #define GC_LISP_OBJECT_ALIGNMENT sizeof (Lisp_Object)
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4518 #endif
49414
668c96afa702 (mark_stack) [!GC_LISP_OBJECT_ALIGNMENT && __GNUC__]:
Dave Love <fx@gnu.org>
parents: 49357
diff changeset
4519 #endif
43161
8a549ab185a2 Fix thinko in last change.
Andreas Schwab <schwab@suse.de>
parents: 43160
diff changeset
4520 for (i = 0; i < sizeof (Lisp_Object); i += GC_LISP_OBJECT_ALIGNMENT)
73964
b684c6771753 (mark_memory): New argument OFFSET. All uses changed.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72537
diff changeset
4521 mark_memory (stack_base, end, i);
58593
ff0c144203a1 (mark_stack): Call GC_MARK_SECONDARY_STACK if defined.
Andreas Schwab <schwab@suse.de>
parents: 57137
diff changeset
4522 /* Allow for marking a secondary stack, like the register stack on the
ff0c144203a1 (mark_stack): Call GC_MARK_SECONDARY_STACK if defined.
Andreas Schwab <schwab@suse.de>
parents: 57137
diff changeset
4523 ia64. */
ff0c144203a1 (mark_stack): Call GC_MARK_SECONDARY_STACK if defined.
Andreas Schwab <schwab@suse.de>
parents: 57137
diff changeset
4524 #ifdef GC_MARK_SECONDARY_STACK
ff0c144203a1 (mark_stack): Call GC_MARK_SECONDARY_STACK if defined.
Andreas Schwab <schwab@suse.de>
parents: 57137
diff changeset
4525 GC_MARK_SECONDARY_STACK ();
ff0c144203a1 (mark_stack): Call GC_MARK_SECONDARY_STACK if defined.
Andreas Schwab <schwab@suse.de>
parents: 57137
diff changeset
4526 #endif
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4527
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4528 #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
4529 check_gcpros ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4530 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4531 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4532
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4533 #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
4534
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4535
72156
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4536 /* Determine whether it is safe to access memory at address P. */
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
4537 static int
72167
b0a67cf52eb6 Whitespace change.
Richard M. Stallman <rms@gnu.org>
parents: 72156
diff changeset
4538 valid_pointer_p (p)
72156
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4539 void *p;
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4540 {
72288
94e8cc9b752d Include w32.h.
Eli Zaretskii <eliz@gnu.org>
parents: 72177
diff changeset
4541 #ifdef WINDOWSNT
94e8cc9b752d Include w32.h.
Eli Zaretskii <eliz@gnu.org>
parents: 72177
diff changeset
4542 return w32_valid_pointer_p (p, 16);
94e8cc9b752d Include w32.h.
Eli Zaretskii <eliz@gnu.org>
parents: 72177
diff changeset
4543 #else
72156
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4544 int fd;
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4545
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4546 /* Obviously, we cannot just access it (we would SEGV trying), so we
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4547 trick the o/s to tell us whether p is a valid pointer.
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4548 Unfortunately, we cannot use NULL_DEVICE here, as emacs_write may
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4549 not validate p in that case. */
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4550
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4551 if ((fd = emacs_open ("__Valid__Lisp__Object__", O_CREAT | O_WRONLY | O_TRUNC, 0666)) >= 0)
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4552 {
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4553 int valid = (emacs_write (fd, (char *)p, 16) == 16);
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4554 emacs_close (fd);
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4555 unlink ("__Valid__Lisp__Object__");
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4556 return valid;
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4557 }
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4558
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4559 return -1;
72288
94e8cc9b752d Include w32.h.
Eli Zaretskii <eliz@gnu.org>
parents: 72177
diff changeset
4560 #endif
72156
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4561 }
66777
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4562
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4563 /* Return 1 if OBJ is a valid lisp object.
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4564 Return 0 if OBJ is NOT a valid lisp object.
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4565 Return -1 if we cannot validate OBJ.
67494
28fd92314a04 Comment and whitespace changes.
Richard M. Stallman <rms@gnu.org>
parents: 67216
diff changeset
4566 This function can be quite slow,
28fd92314a04 Comment and whitespace changes.
Richard M. Stallman <rms@gnu.org>
parents: 67216
diff changeset
4567 so it should only be used in code for manual debugging. */
66777
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4568
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4569 int
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4570 valid_lisp_object_p (obj)
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4571 Lisp_Object obj;
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4572 {
67216
fc58516afccd Include fcntl.h. Define O_WRONLY if not defined.
Kim F. Storm <storm@cua.dk>
parents: 66889
diff changeset
4573 void *p;
72156
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4574 #if GC_MARK_STACK
66777
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4575 struct mem_node *m;
67216
fc58516afccd Include fcntl.h. Define O_WRONLY if not defined.
Kim F. Storm <storm@cua.dk>
parents: 66889
diff changeset
4576 #endif
66777
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4577
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4578 if (INTEGERP (obj))
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4579 return 1;
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4580
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4581 p = (void *) XPNTR (obj);
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4582 if (PURE_POINTER_P (p))
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4583 return 1;
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4584
67216
fc58516afccd Include fcntl.h. Define O_WRONLY if not defined.
Kim F. Storm <storm@cua.dk>
parents: 66889
diff changeset
4585 #if !GC_MARK_STACK
72156
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4586 return valid_pointer_p (p);
67216
fc58516afccd Include fcntl.h. Define O_WRONLY if not defined.
Kim F. Storm <storm@cua.dk>
parents: 66889
diff changeset
4587 #else
fc58516afccd Include fcntl.h. Define O_WRONLY if not defined.
Kim F. Storm <storm@cua.dk>
parents: 66889
diff changeset
4588
66777
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4589 m = mem_find (p);
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4590
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4591 if (m == MEM_NIL)
72156
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4592 {
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4593 int valid = valid_pointer_p (p);
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4594 if (valid <= 0)
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4595 return valid;
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4596
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4597 if (SUBRP (obj))
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4598 return 1;
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4599
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4600 return 0;
b4ec5a95c687 (valid_pointer_p): New function (from valid_lisp_object_p).
Kim F. Storm <storm@cua.dk>
parents: 72114
diff changeset
4601 }
66777
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4602
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4603 switch (m->type)
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4604 {
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4605 case MEM_TYPE_NON_LISP:
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4606 return 0;
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4607
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4608 case MEM_TYPE_BUFFER:
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4609 return live_buffer_p (m, p);
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4610
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4611 case MEM_TYPE_CONS:
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4612 return live_cons_p (m, p);
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4613
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4614 case MEM_TYPE_STRING:
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4615 return live_string_p (m, p);
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4616
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4617 case MEM_TYPE_MISC:
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4618 return live_misc_p (m, p);
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4619
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4620 case MEM_TYPE_SYMBOL:
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4621 return live_symbol_p (m, p);
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4622
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4623 case MEM_TYPE_FLOAT:
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4624 return live_float_p (m, p);
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4625
84978
33b7fe948502 (enum mem_type): Replace all vector subtypes -> MEM_TYPE_VECTORLIKE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84977
diff changeset
4626 case MEM_TYPE_VECTORLIKE:
66777
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4627 return live_vector_p (m, p);
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4628
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4629 default:
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4630 break;
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4631 }
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4632
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4633 return 0;
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4634 #endif
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4635 }
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4636
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4637
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
4638
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4639
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4640 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4641 Pure Storage Management
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4642 ***********************************************************************/
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4643
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4644 /* 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
4645 pointer to it. TYPE is the Lisp type for which the memory is
72027
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4646 allocated. TYPE < 0 means it's not used for a Lisp object. */
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4647
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4648 static POINTER_TYPE *
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4649 pure_alloc (size, type)
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4650 size_t size;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4651 int type;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4652 {
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4653 POINTER_TYPE *result;
53650
5558449888ec (lisp_malloc, lisp_align_malloc) [USE_LSB_TAG]:
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53582
diff changeset
4654 #ifdef USE_LSB_TAG
5558449888ec (lisp_malloc, lisp_align_malloc) [USE_LSB_TAG]:
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53582
diff changeset
4655 size_t alignment = (1 << GCTYPEBITS);
5558449888ec (lisp_malloc, lisp_align_malloc) [USE_LSB_TAG]:
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53582
diff changeset
4656 #else
49159
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4657 size_t alignment = sizeof (EMACS_INT);
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4658
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4659 /* Give Lisp_Floats an extra alignment. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4660 if (type == Lisp_Float)
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4661 {
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4662 #if defined __GNUC__ && __GNUC__ >= 2
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4663 alignment = __alignof (struct Lisp_Float);
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4664 #else
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4665 alignment = sizeof (struct Lisp_Float);
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4666 #endif
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4667 }
53650
5558449888ec (lisp_malloc, lisp_align_malloc) [USE_LSB_TAG]:
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53582
diff changeset
4668 #endif
49159
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4669
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4670 again:
72027
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4671 if (type >= 0)
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4672 {
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4673 /* Allocate space for a Lisp object from the beginning of the free
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4674 space with taking account of alignment. */
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4675 result = ALIGN (purebeg + pure_bytes_used_lisp, alignment);
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4676 pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size;
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4677 }
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4678 else
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4679 {
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4680 /* Allocate space for a non-Lisp object from the end of the free
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4681 space. */
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4682 pure_bytes_used_non_lisp += size;
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4683 result = purebeg + pure_size - pure_bytes_used_non_lisp;
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4684 }
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4685 pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp;
49159
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4686
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4687 if (pure_bytes_used <= pure_size)
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4688 return result;
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4689
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4690 /* Don't allocate a large amount here,
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4691 because it might get mmap'd and then its address
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4692 might not be usable. */
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4693 purebeg = (char *) xmalloc (10000);
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4694 pure_size = 10000;
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4695 pure_bytes_used_before_overflow += pure_bytes_used - size;
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4696 pure_bytes_used = 0;
72027
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
4697 pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
49159
bc82a79251b5 (pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents: 49158
diff changeset
4698 goto again;
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4699 }
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4700
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4701
44149
a3e6cfa20afd (check_pure_size): Update the comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 44100
diff changeset
4702 /* Print a warning if PURESIZE is too small. */
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4703
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4704 void
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4705 check_pure_size ()
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4706 {
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4707 if (pure_bytes_used_before_overflow)
68398
cec05baae14f (check_pure_size): Make overflow message an "error message".
Richard M. Stallman <rms@gnu.org>
parents: 68369
diff changeset
4708 message ("emacs:0:Pure Lisp storage overflow (approx. %d bytes needed)",
44100
57e965380c39 (check_pure_size): Only output a warning.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43751
diff changeset
4709 (int) (pure_bytes_used + pure_bytes_used_before_overflow));
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4710 }
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4711
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4712
72114
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4713 /* Find the byte sequence {DATA[0], ..., DATA[NBYTES-1], '\0'} from
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4714 the non-Lisp data pool of the pure storage, and return its start
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4715 address. Return NULL if not found. */
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4716
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4717 static char *
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4718 find_string_data_in_pure (data, nbytes)
106950
ddd257e3f816 Make string pointer args point to const as in other string allocation functions.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 106815
diff changeset
4719 const char *data;
72114
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4720 int nbytes;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4721 {
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4722 int i, skip, bm_skip[256], last_char_skip, infinity, start, start_max;
106950
ddd257e3f816 Make string pointer args point to const as in other string allocation functions.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 106815
diff changeset
4723 const unsigned char *p;
72114
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4724 char *non_lisp_beg;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4725
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4726 if (pure_bytes_used_non_lisp < nbytes + 1)
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4727 return NULL;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4728
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4729 /* Set up the Boyer-Moore table. */
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4730 skip = nbytes + 1;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4731 for (i = 0; i < 256; i++)
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4732 bm_skip[i] = skip;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4733
106950
ddd257e3f816 Make string pointer args point to const as in other string allocation functions.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 106815
diff changeset
4734 p = (const unsigned char *) data;
72114
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4735 while (--skip > 0)
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4736 bm_skip[*p++] = skip;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4737
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4738 last_char_skip = bm_skip['\0'];
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4739
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4740 non_lisp_beg = purebeg + pure_size - pure_bytes_used_non_lisp;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4741 start_max = pure_bytes_used_non_lisp - (nbytes + 1);
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4742
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4743 /* See the comments in the function `boyer_moore' (search.c) for the
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4744 use of `infinity'. */
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4745 infinity = pure_bytes_used_non_lisp + 1;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4746 bm_skip['\0'] = infinity;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4747
106950
ddd257e3f816 Make string pointer args point to const as in other string allocation functions.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 106815
diff changeset
4748 p = (const unsigned char *) non_lisp_beg + nbytes;
72114
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4749 start = 0;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4750 do
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4751 {
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4752 /* Check the last character (== '\0'). */
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4753 do
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4754 {
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4755 start += bm_skip[*(p + start)];
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4756 }
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4757 while (start <= start_max);
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4758
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4759 if (start < infinity)
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4760 /* Couldn't find the last character. */
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4761 return NULL;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4762
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4763 /* No less than `infinity' means we could find the last
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4764 character at `p[start - infinity]'. */
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4765 start -= infinity;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4766
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4767 /* Check the remaining characters. */
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4768 if (memcmp (data, non_lisp_beg + start, nbytes) == 0)
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4769 /* Found. */
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4770 return non_lisp_beg + start;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4771
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4772 start += last_char_skip;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4773 }
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4774 while (start <= start_max);
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4775
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4776 return NULL;
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4777 }
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4778
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4779
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4780 /* 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
4781 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
4782 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
4783
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4784 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
4785 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
4786 string; then the string is not protected from gc. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4787
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4788 Lisp_Object
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4789 make_pure_string (data, nchars, nbytes, multibyte)
106950
ddd257e3f816 Make string pointer args point to const as in other string allocation functions.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 106815
diff changeset
4790 const char *data;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4791 int nchars, nbytes;
21258
693573ac0944 (make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
4792 int multibyte;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4793 {
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4794 Lisp_Object string;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4795 struct Lisp_String *s;
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4796
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4797 s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
72114
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4798 s->data = find_string_data_in_pure (data, nbytes);
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4799 if (s->data == NULL)
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4800 {
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4801 s->data = (unsigned char *) pure_alloc (nbytes + 1, -1);
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4802 bcopy (data, s->data, nbytes);
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4803 s->data[nbytes] = '\0';
fe7f8d2385f8 (find_string_data_in_pure): New function.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 72027
diff changeset
4804 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4805 s->size = nchars;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4806 s->size_byte = multibyte ? nbytes : -1;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4807 s->intervals = NULL_INTERVAL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4808 XSETSTRING (string, s);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4809 return string;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4810 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4811
105871
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4812 /* Return a string a string allocated in pure space. Do not allocate
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4813 the string data, just point to DATA. */
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4814
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4815 Lisp_Object
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4816 make_pure_c_string (const char *data)
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4817 {
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4818 Lisp_Object string;
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4819 struct Lisp_String *s;
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4820 int nchars = strlen (data);
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4821
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4822 s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4823 s->size = nchars;
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4824 s->size_byte = -1;
105881
7d244791c020 (make_pure_c_string): Fix last change to avoid compiler warning.
Eli Zaretskii <eliz@gnu.org>
parents: 105877
diff changeset
4825 s->data = (unsigned char *) data;
105871
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4826 s->intervals = NULL_INTERVAL;
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4827 XSETSTRING (string, s);
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4828 return string;
1fa408e42f53 * alloc.c (make_pure_c_string): New function.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105669
diff changeset
4829 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4830
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4831 /* 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
4832 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
4833
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4834 Lisp_Object
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4835 pure_cons (car, cdr)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4836 Lisp_Object car, cdr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4837 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4838 register Lisp_Object new;
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4839 struct Lisp_Cons *p;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4840
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4841 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
4842 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
4843 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
4844 XSETCDR (new, Fpurecopy (cdr));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4845 return new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4846 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4847
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4848
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4849 /* 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
4850
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
4851 static Lisp_Object
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4852 make_pure_float (num)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4853 double num;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4854 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4855 register Lisp_Object new;
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4856 struct Lisp_Float *p;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4857
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4858 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
4859 XSETFLOAT (new, p);
104313
73f76307d49b * lisp.h (XFLOAT_DATA): Produce an rvalue by adding 0 to the value.
Ken Raeburn <raeburn@raeburn.org>
parents: 101689
diff changeset
4860 XFLOAT_INIT (new, num);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4861 return new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4862 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4863
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4864
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4865 /* 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
4866 pure space. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4867
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4868 Lisp_Object
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4869 make_pure_vector (len)
8817
48ff00bebef6 (pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
4870 EMACS_INT len;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4871 {
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4872 Lisp_Object new;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4873 struct Lisp_Vector *p;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4874 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
4875
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4876 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
4877 XSETVECTOR (new, p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4878 XVECTOR (new)->size = len;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4879 return new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4880 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4881
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4882
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4883 DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
68741
2892a36e596e (Fmake_bool_vector, Fpurecopy): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 68430
diff changeset
4884 doc: /* Make a copy of object OBJ in pure storage.
39914
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
4885 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
4886 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
4887 (obj)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4888 register Lisp_Object obj;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4889 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 434
diff changeset
4890 if (NILP (Vpurify_flag))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4891 return obj;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4892
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4893 if (PURE_POINTER_P (XPNTR (obj)))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4894 return obj;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4895
107895
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4896 if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4897 {
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4898 Lisp_Object tmp = Fgethash (obj, Vpurify_flag, Qnil);
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4899 if (!NILP (tmp))
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4900 return tmp;
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4901 }
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4902
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
4903 if (CONSP (obj))
107895
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4904 obj = pure_cons (XCAR (obj), XCDR (obj));
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
4905 else if (FLOATP (obj))
107895
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4906 obj = make_pure_float (XFLOAT_DATA (obj));
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
4907 else if (STRINGP (obj))
107895
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4908 obj = make_pure_string (SDATA (obj), SCHARS (obj),
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4909 SBYTES (obj),
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4910 STRING_MULTIBYTE (obj));
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
4911 else if (COMPILEDP (obj) || VECTORP (obj))
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
4912 {
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
4913 register struct Lisp_Vector *vec;
53705
db8cbe59ee5c (Fpurecopy): Declare size as EMACS_INT to not lose bits.
Andreas Schwab <schwab@suse.de>
parents: 53650
diff changeset
4914 register int i;
db8cbe59ee5c (Fpurecopy): Declare size as EMACS_INT to not lose bits.
Andreas Schwab <schwab@suse.de>
parents: 53650
diff changeset
4915 EMACS_INT size;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4916
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
4917 size = XVECTOR (obj)->size;
10427
5faba1b094d5 (Fpurecopy): Mask size field when copying pseudovector.
Karl Heuer <kwzh@gnu.org>
parents: 10414
diff changeset
4918 if (size & PSEUDOVECTOR_FLAG)
5faba1b094d5 (Fpurecopy): Mask size field when copying pseudovector.
Karl Heuer <kwzh@gnu.org>
parents: 10414
diff changeset
4919 size &= PSEUDOVECTOR_SIZE_MASK;
53705
db8cbe59ee5c (Fpurecopy): Declare size as EMACS_INT to not lose bits.
Andreas Schwab <schwab@suse.de>
parents: 53650
diff changeset
4920 vec = XVECTOR (make_pure_vector (size));
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
4921 for (i = 0; i < size; i++)
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
4922 vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
4923 if (COMPILEDP (obj))
85329
ad9922c079e4 (Fpurecopy): Set the pvec tag on pseudo vectors.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85328
diff changeset
4924 {
ad9922c079e4 (Fpurecopy): Set the pvec tag on pseudo vectors.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85328
diff changeset
4925 XSETPVECTYPE (vec, PVEC_COMPILED);
ad9922c079e4 (Fpurecopy): Set the pvec tag on pseudo vectors.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85328
diff changeset
4926 XSETCOMPILED (obj, vec);
ad9922c079e4 (Fpurecopy): Set the pvec tag on pseudo vectors.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85328
diff changeset
4927 }
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
4928 else
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
4929 XSETVECTOR (obj, vec);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4930 }
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
4931 else if (MARKERP (obj))
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
4932 error ("Attempt to copy a marker to pure storage");
107895
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4933 else
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4934 /* Not purified, don't hash-cons. */
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4935 return obj;
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4936
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4937 if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
4938 Fputhash (obj, obj, Vpurify_flag);
31829
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
4939
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
4940 return obj;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4941 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4942
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4943
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4944
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4945 /***********************************************************************
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4946 Protection from GC
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4947 ***********************************************************************/
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4948
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4949 /* 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
4950 VARADDRESS. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4951
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4952 void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4953 staticpro (varaddress)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4954 Lisp_Object *varaddress;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4955 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4956 staticvec[staticidx++] = varaddress;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4957 if (staticidx >= NSTATICS)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4958 abort ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4959 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4960
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4961
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4962 /***********************************************************************
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4963 Protection from GC
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4964 ***********************************************************************/
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
4965
11374
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4966 /* Temporarily prevent garbage collection. */
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4967
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4968 int
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4969 inhibit_garbage_collection ()
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4970 {
46293
1fb8f75062c6 Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents: 46285
diff changeset
4971 int count = SPECPDL_INDEX ();
41867
a555c6419185 (inhibit_garbage_collection): Don't exceed value an int can hold.
Andreas Schwab <schwab@suse.de>
parents: 41831
diff changeset
4972 int nbits = min (VALBITS, BITS_PER_INT);
a555c6419185 (inhibit_garbage_collection): Don't exceed value an int can hold.
Andreas Schwab <schwab@suse.de>
parents: 41831
diff changeset
4973
a555c6419185 (inhibit_garbage_collection): Don't exceed value an int can hold.
Andreas Schwab <schwab@suse.de>
parents: 41831
diff changeset
4974 specbind (Qgc_cons_threshold, make_number (((EMACS_INT) 1 << (nbits - 1)) - 1));
11374
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4975 return count;
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4976 }
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4977
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4978
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4979 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
4980 doc: /* Reclaim storage for Lisp objects no longer needed.
51788
43d663a05e2d (Fgarbage_collect): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 51779
diff changeset
4981 Garbage collection happens automatically if you cons more than
43d663a05e2d (Fgarbage_collect): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 51779
diff changeset
4982 `gc-cons-threshold' bytes of Lisp data since previous garbage collection.
43d663a05e2d (Fgarbage_collect): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 51779
diff changeset
4983 `garbage-collect' normally returns a list with info on amount of space in use:
39914
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
4984 ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
4985 (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
4986 (USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS)
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
4987 (USED-STRINGS . FREE-STRINGS))
51788
43d663a05e2d (Fgarbage_collect): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 51779
diff changeset
4988 However, if there was overflow in pure space, `garbage-collect'
43d663a05e2d (Fgarbage_collect): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 51779
diff changeset
4989 returns nil, because real GC can't be done. */)
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4990 ()
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4991 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4992 register struct specbinding *bind;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4993 struct catchtag *catch;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4994 struct handler *handler;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4995 char stack_top_variable;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4996 register int i;
25343
fe92158a9e83 (Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents: 25133
diff changeset
4997 int message_p;
34270
773e6aa2ec38 (Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents: 33800
diff changeset
4998 Lisp_Object total[8];
46285
3f111801efb4 Rename BINDING_STACK_SIZE to SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents: 45392
diff changeset
4999 int count = SPECPDL_INDEX ();
49529
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
5000 EMACS_TIME t1, t2, t3;
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
5001
50745
fedd03de0f46 (abort_on_gc): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 50626
diff changeset
5002 if (abort_on_gc)
fedd03de0f46 (abort_on_gc): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 50626
diff changeset
5003 abort ();
fedd03de0f46 (abort_on_gc): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 50626
diff changeset
5004
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5005 /* 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
5006 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
5007 if (pure_bytes_used_before_overflow)
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5008 return Qnil;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5009
61252
d24c6e8f9add (Fgarbage_collect): Call CHECK_CONS_LIST before and after gc.
Kim F. Storm <storm@cua.dk>
parents: 61225
diff changeset
5010 CHECK_CONS_LIST ();
d24c6e8f9add (Fgarbage_collect): Call CHECK_CONS_LIST before and after gc.
Kim F. Storm <storm@cua.dk>
parents: 61225
diff changeset
5011
59047
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5012 /* Don't keep undo information around forever.
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5013 Do this early on, so it is no problem if the user quits. */
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5014 {
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5015 register struct buffer *nextb = all_buffers;
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5016
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5017 while (nextb)
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5018 {
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5019 /* If a buffer's undo list is Qt, that means that undo is
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5020 turned off in that buffer. Calling truncate_undo_list on
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5021 Qt tends to return NULL, which effectively turns undo back on.
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5022 So don't call truncate_undo_list if undo_list is Qt. */
59314
9c620c1aa7fa (Fgarbage_collect): Don't truncate_undo_list on dead buffers.
Richard M. Stallman <rms@gnu.org>
parents: 59083
diff changeset
5023 if (! NILP (nextb->name) && ! EQ (nextb->undo_list, Qt))
59047
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5024 truncate_undo_list (nextb);
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5025
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5026 /* Shrink buffer gaps, but skip indirect and dead buffers. */
90774
81fa456eb1dc (Fgarbage_collect): If nextb->text->inhibit_shrinking is
Kenichi Handa <handa@m17n.org>
parents: 90743
diff changeset
5027 if (nextb->base_buffer == 0 && !NILP (nextb->name)
81fa456eb1dc (Fgarbage_collect): If nextb->text->inhibit_shrinking is
Kenichi Handa <handa@m17n.org>
parents: 90743
diff changeset
5028 && ! nextb->text->inhibit_shrinking)
59047
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5029 {
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5030 /* If a buffer's gap size is more than 10% of the buffer
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5031 size, or larger than 2000 bytes, then shrink it
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5032 accordingly. Keep a minimum size of 20 bytes. */
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5033 int size = min (2000, max (20, (nextb->text->z_byte / 10)));
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5034
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5035 if (nextb->text->gap_size > size)
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5036 {
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5037 struct buffer *save_current = current_buffer;
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5038 current_buffer = nextb;
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5039 make_gap (-(nextb->text->gap_size - size));
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5040 current_buffer = save_current;
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5041 }
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5042 }
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5043
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5044 nextb = nextb->next;
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5045 }
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5046 }
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5047
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5048 EMACS_GET_TIME (t1);
0d2678a6add0 (Fgarbage_collect): Update call to truncate_undo_list.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
5049
11892
6be0b7a0ac44 (Fgarbage_collect): Clear consing_since_gc first thing.
Karl Heuer <kwzh@gnu.org>
parents: 11727
diff changeset
5050 /* 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
5051 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
5052 consing_since_gc = 0;
6be0b7a0ac44 (Fgarbage_collect): Clear consing_since_gc first thing.
Karl Heuer <kwzh@gnu.org>
parents: 11727
diff changeset
5053
25343
fe92158a9e83 (Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents: 25133
diff changeset
5054 /* 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
5055 message_p = push_message ();
47391
1afd007f814f (Fgarbage_collect): Use pop_message_unwind.
Richard M. Stallman <rms@gnu.org>
parents: 47185
diff changeset
5056 record_unwind_protect (pop_message_unwind, Qnil);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5057
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5058 /* Save a copy of the contents of the stack, for debugging. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5059 #if MAX_SAVE_STACK > 0
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 434
diff changeset
5060 if (NILP (Vpurify_flag))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5061 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5062 i = &stack_top_variable - stack_bottom;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5063 if (i < 0) i = -i;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5064 if (i < MAX_SAVE_STACK)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5065 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5066 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
5067 stack_copy = (char *) xmalloc (stack_copy_size = i);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5068 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
5069 stack_copy = (char *) xrealloc (stack_copy, (stack_copy_size = i));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5070 if (stack_copy)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5071 {
8817
48ff00bebef6 (pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
5072 if ((EMACS_INT) (&stack_top_variable - stack_bottom) > 0)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5073 bcopy (stack_bottom, stack_copy, i);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5074 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5075 bcopy (&stack_top_variable, stack_copy, i);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5076 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5077 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5078 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5079 #endif /* MAX_SAVE_STACK > 0 */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5080
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
5081 if (garbage_collection_messages)
10395
c121703d35c7 (Fgarbage_collect): Don't log the GC message.
Karl Heuer <kwzh@gnu.org>
parents: 10389
diff changeset
5082 message1_nolog ("Garbage collecting...");
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5083
23534
6f9c70db3a58 (Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents: 22382
diff changeset
5084 BLOCK_INPUT;
6f9c70db3a58 (Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents: 22382
diff changeset
5085
22220
a0cd311af6e3 (Fgarbage_collect): Call shrink_regexp_cache.
Richard M. Stallman <rms@gnu.org>
parents: 21948
diff changeset
5086 shrink_regexp_cache ();
a0cd311af6e3 (Fgarbage_collect): Call shrink_regexp_cache.
Richard M. Stallman <rms@gnu.org>
parents: 21948
diff changeset
5087
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5088 gc_in_progress = 1;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5089
16231
5ce3b59f093b Comment changes.
Erik Naggum <erik@naggum.no>
parents: 16223
diff changeset
5090 /* clear_marks (); */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5091
52473
a3fd06a8c844 (init_intervals, init_symbol, init_marker): Don't preallocate anything.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52453
diff changeset
5092 /* Mark all the special slots that serve as the roots of accessibility. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5093
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5094 for (i = 0; i < staticidx; i++)
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5095 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
5096
57098
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
5097 for (bind = specpdl; bind != specpdl_ptr; bind++)
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
5098 {
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
5099 mark_object (bind->symbol);
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
5100 mark_object (bind->old_value);
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
5101 }
83431
76396de7f50a Rename `struct device' to `struct terminal'. Rename some terminal-related functions similarly.
Karoly Lorentey <lorentey@elte.hu>
parents: 83420
diff changeset
5102 mark_terminals ();
57098
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
5103 mark_kboards ();
83206
b5dee7c1d483 Merged in changes from CVS trunk.
Karoly Lorentey <lorentey@elte.hu>
parents: 83182 57098
diff changeset
5104 mark_ttys ();
57098
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
5105
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
5106 #ifdef USE_GTK
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
5107 {
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
5108 extern void xg_mark_data ();
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
5109 xg_mark_data ();
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
5110 }
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
5111 #endif
0487c26b96ee (Fgarbage_collect): Mark keyboards, gtk data, and specpdl
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 56539
diff changeset
5112
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5113 #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
5114 || 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
5115 mark_stack ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5116 #else
51228
42d9bef83464 (Fgarbage_collect): Remove `unused var tail' warning.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51029
diff changeset
5117 {
42d9bef83464 (Fgarbage_collect): Remove `unused var tail' warning.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51029
diff changeset
5118 register struct gcpro *tail;
42d9bef83464 (Fgarbage_collect): Remove `unused var tail' warning.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51029
diff changeset
5119 for (tail = gcprolist; tail; tail = tail->next)
42d9bef83464 (Fgarbage_collect): Remove `unused var tail' warning.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51029
diff changeset
5120 for (i = 0; i < tail->nvars; i++)
52473
a3fd06a8c844 (init_intervals, init_symbol, init_marker): Don't preallocate anything.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52453
diff changeset
5121 mark_object (tail->var[i]);
51228
42d9bef83464 (Fgarbage_collect): Remove `unused var tail' warning.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51029
diff changeset
5122 }
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5123 #endif
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
5124
26364
7b0217d9259c (Fgarbage_collect): Call mark_byte_stack and
Gerd Moellmann <gerd@gnu.org>
parents: 26164
diff changeset
5125 mark_byte_stack ();
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5126 for (catch = catchlist; catch; catch = catch->next)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5127 {
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5128 mark_object (catch->tag);
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5129 mark_object (catch->val);
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
5130 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5131 for (handler = handlerlist; handler; handler = handler->next)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5132 {
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5133 mark_object (handler->handler);
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5134 mark_object (handler->var);
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
5135 }
55798
a1bb695e9a0c (struct backtrace): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55767
diff changeset
5136 mark_backtrace ();
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5137
59400
eeb8b96d077d (mark_fringe_data): Declare extern.
Kim F. Storm <storm@cua.dk>
parents: 59359
diff changeset
5138 #ifdef HAVE_WINDOW_SYSTEM
eeb8b96d077d (mark_fringe_data): Declare extern.
Kim F. Storm <storm@cua.dk>
parents: 59359
diff changeset
5139 mark_fringe_data ();
eeb8b96d077d (mark_fringe_data): Declare extern.
Kim F. Storm <storm@cua.dk>
parents: 59359
diff changeset
5140 #endif
eeb8b96d077d (mark_fringe_data): Declare extern.
Kim F. Storm <storm@cua.dk>
parents: 59359
diff changeset
5141
55667
57f4a242e8f4 (Fgarbage_collect): Do all the marking before flushing
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55635
diff changeset
5142 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
57f4a242e8f4 (Fgarbage_collect): Do all the marking before flushing
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55635
diff changeset
5143 mark_stack ();
57f4a242e8f4 (Fgarbage_collect): Do all the marking before flushing
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55635
diff changeset
5144 #endif
57f4a242e8f4 (Fgarbage_collect): Do all the marking before flushing
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55635
diff changeset
5145
55816
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5146 /* Everything is now marked, except for the things that require special
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5147 finalization, i.e. the undo_list.
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5148 Look thru every buffer's undo list
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5149 for elements that update markers that were not marked,
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5150 and delete them. */
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5151 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5152 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
5153
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5154 while (nextb)
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5155 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5156 /* If a buffer's undo list is Qt, that means that undo is
55816
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5157 turned off in that buffer. Calling truncate_undo_list on
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5158 Qt tends to return NULL, which effectively turns undo back on.
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5159 So don't call truncate_undo_list if undo_list is Qt. */
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5160 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
5161 {
55816
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5162 Lisp_Object tail, prev;
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5163 tail = nextb->undo_list;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5164 prev = Qnil;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5165 while (CONSP (tail))
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5166 {
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
5167 if (CONSP (XCAR (tail))
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
5168 && MARKERP (XCAR (XCAR (tail)))
55816
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5169 && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5170 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5171 if (NILP (prev))
55816
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5172 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
5173 else
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39914
diff changeset
5174 {
55816
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5175 tail = XCDR (tail);
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39914
diff changeset
5176 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
5177 }
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5178 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5179 else
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5180 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5181 prev = tail;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
5182 tail = XCDR (tail);
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5183 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5184 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5185 }
55816
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5186 /* Now that we have stripped the elements that need not be in the
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5187 undo_list any more, we can finally mark the list. */
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5188 mark_object (nextb->undo_list);
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5189
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5190 nextb = nextb->next;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5191 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5192 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5193
55816
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5194 gc_sweep ();
55767
ee3a30045908 (marker_blocks_pending_free): New var.
Kim F. Storm <storm@cua.dk>
parents: 55745
diff changeset
5195
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5196 /* Clear the mark bits that we set in certain root slots. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5197
26378
cbf297593a79 (Fgarbage_collect): Call unmark_byte_stack.
Gerd Moellmann <gerd@gnu.org>
parents: 26372
diff changeset
5198 unmark_byte_stack ();
51683
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
5199 VECTOR_UNMARK (&buffer_defaults);
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
5200 VECTOR_UNMARK (&buffer_local_symbols);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5201
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5202 #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
5203 dump_zombies ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5204 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5205
23534
6f9c70db3a58 (Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents: 22382
diff changeset
5206 UNBLOCK_INPUT;
6f9c70db3a58 (Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents: 22382
diff changeset
5207
61252
d24c6e8f9add (Fgarbage_collect): Call CHECK_CONS_LIST before and after gc.
Kim F. Storm <storm@cua.dk>
parents: 61225
diff changeset
5208 CHECK_CONS_LIST ();
d24c6e8f9add (Fgarbage_collect): Call CHECK_CONS_LIST before and after gc.
Kim F. Storm <storm@cua.dk>
parents: 61225
diff changeset
5209
16231
5ce3b59f093b Comment changes.
Erik Naggum <erik@naggum.no>
parents: 16223
diff changeset
5210 /* clear_marks (); */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5211 gc_in_progress = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5212
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5213 consing_since_gc = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5214 if (gc_cons_threshold < 10000)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5215 gc_cons_threshold = 10000;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5216
64267
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
5217 if (FLOATP (Vgc_cons_percentage))
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
5218 { /* Set gc_cons_combined_threshold. */
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
5219 EMACS_INT total = 0;
64611
47f158dcf216 (gc_cons_threshold): Not static.
Richard M. Stallman <rms@gnu.org>
parents: 64273
diff changeset
5220
64267
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
5221 total += total_conses * sizeof (struct Lisp_Cons);
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
5222 total += total_symbols * sizeof (struct Lisp_Symbol);
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
5223 total += total_markers * sizeof (union Lisp_Misc);
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
5224 total += total_string_size;
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
5225 total += total_vector_size * sizeof (Lisp_Object);
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
5226 total += total_floats * sizeof (struct Lisp_Float);
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
5227 total += total_intervals * sizeof (struct interval);
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
5228 total += total_strings * sizeof (struct Lisp_String);
66777
25bf8ea82843 (valid_lisp_object_p): New function to validate that
Kim F. Storm <storm@cua.dk>
parents: 66662
diff changeset
5229
64611
47f158dcf216 (gc_cons_threshold): Not static.
Richard M. Stallman <rms@gnu.org>
parents: 64273
diff changeset
5230 gc_relative_threshold = total * XFLOAT_DATA (Vgc_cons_percentage);
64267
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
5231 }
64611
47f158dcf216 (gc_cons_threshold): Not static.
Richard M. Stallman <rms@gnu.org>
parents: 64273
diff changeset
5232 else
47f158dcf216 (gc_cons_threshold): Not static.
Richard M. Stallman <rms@gnu.org>
parents: 64273
diff changeset
5233 gc_relative_threshold = 0;
64267
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
5234
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
5235 if (garbage_collection_messages)
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
5236 {
25343
fe92158a9e83 (Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents: 25133
diff changeset
5237 if (message_p || minibuf_level > 0)
fe92158a9e83 (Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents: 25133
diff changeset
5238 restore_message ();
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
5239 else
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
5240 message1_nolog ("Garbage collecting...done");
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
5241 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5242
35170
a9b677239421 (Fgarbage_collect): Use a record_unwind_protect to
Gerd Moellmann <gerd@gnu.org>
parents: 34325
diff changeset
5243 unbind_to (count, Qnil);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5244
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5245 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
5246 make_number (total_free_conses));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5247 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
5248 make_number (total_free_symbols));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5249 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
5250 make_number (total_free_markers));
34270
773e6aa2ec38 (Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents: 33800
diff changeset
5251 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
5252 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
5253 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
5254 make_number (total_free_floats));
34270
773e6aa2ec38 (Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents: 33800
diff changeset
5255 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
5256 make_number (total_free_intervals));
34270
773e6aa2ec38 (Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents: 33800
diff changeset
5257 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
5258 make_number (total_free_strings));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5259
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5260 #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
5261 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5262 /* 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
5263 double nlive = 0;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
5264
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5265 for (i = 0; i < 7; ++i)
49357
90e4c5eeb9a0 (Fgc_status): Print zombie list.
Dave Love <fx@gnu.org>
parents: 49322
diff changeset
5266 if (CONSP (total[i]))
90e4c5eeb9a0 (Fgc_status): Print zombie list.
Dave Love <fx@gnu.org>
parents: 49322
diff changeset
5267 nlive += XFASTINT (XCAR (total[i]));
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5268
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5269 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
5270 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
5271 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
5272 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
5273 ++ngcs;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5274 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5275 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5276
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5277 if (!NILP (Vpost_gc_hook))
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5278 {
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5279 int count = inhibit_garbage_collection ();
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5280 safe_run_hooks (Qpost_gc_hook);
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5281 unbind_to (count, Qnil);
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5282 }
49529
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
5283
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
5284 /* Accumulate statistics. */
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
5285 EMACS_GET_TIME (t2);
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
5286 EMACS_SUB_TIME (t3, t2, t1);
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
5287 if (FLOATP (Vgc_elapsed))
49911
d9ade23e09df (Fgarbage_collect): Don't use XSETFLOAT.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49600
diff changeset
5288 Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed) +
d9ade23e09df (Fgarbage_collect): Don't use XSETFLOAT.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49600
diff changeset
5289 EMACS_SECS (t3) +
d9ade23e09df (Fgarbage_collect): Don't use XSETFLOAT.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49600
diff changeset
5290 EMACS_USECS (t3) * 1.0e-6);
49529
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
5291 gcs_done++;
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
5292
34270
773e6aa2ec38 (Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents: 33800
diff changeset
5293 return Flist (sizeof total / sizeof *total, total);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5294 }
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5295
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5296
25367
823e14641544 (mark_glyph_matrix): Mark strings only.
Gerd Moellmann <gerd@gnu.org>
parents: 25343
diff changeset
5297 /* 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
5298 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
5299
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5300 static void
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5301 mark_glyph_matrix (matrix)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5302 struct glyph_matrix *matrix;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5303 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5304 struct glyph_row *row = matrix->rows;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5305 struct glyph_row *end = row + matrix->nrows;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5306
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5307 for (; row < end; ++row)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5308 if (row->enabled_p)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5309 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5310 int area;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5311 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
5312 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5313 struct glyph *glyph = row->glyphs[area];
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5314 struct glyph *end_glyph = glyph + row->used[area];
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
5315
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5316 for (; glyph < end_glyph; ++glyph)
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
5317 if (STRINGP (glyph->object)
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5318 && !STRING_MARKED_P (XSTRING (glyph->object)))
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5319 mark_object (glyph->object);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5320 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5321 }
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5322 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5323
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5324
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5325 /* 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
5326
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5327 static void
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5328 mark_face_cache (c)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5329 struct face_cache *c;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5330 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5331 if (c)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5332 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5333 int i, j;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5334 for (i = 0; i < c->used; ++i)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5335 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5336 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
5337
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5338 if (face)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5339 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5340 for (j = 0; j < LFACE_VECTOR_SIZE; ++j)
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5341 mark_object (face->lface[j]);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5342 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5343 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5344 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5345 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5346
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5347
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5348
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
5349 /* 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
5350 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
5351 all the references contained in it. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5352
1168
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
5353 #define LAST_MARKED_SIZE 500
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
5354 static Lisp_Object last_marked[LAST_MARKED_SIZE];
1168
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
5355 int last_marked_index;
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
5356
46833
b80760a75295 (mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents: 46459
diff changeset
5357 /* For debugging--call abort when we cdr down this many
b80760a75295 (mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents: 46459
diff changeset
5358 links of a list, in mark_object. In debugging,
b80760a75295 (mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents: 46459
diff changeset
5359 the call to abort will hit a breakpoint.
b80760a75295 (mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents: 46459
diff changeset
5360 Normally this is zero and the check never goes off. */
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
5361 static int mark_object_loop_halt;
46833
b80760a75295 (mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents: 46459
diff changeset
5362
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5363 static void
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5364 mark_vectorlike (ptr)
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5365 struct Lisp_Vector *ptr;
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5366 {
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5367 register EMACS_INT size = ptr->size;
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5368 register int i;
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5369
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5370 eassert (!VECTOR_MARKED_P (ptr));
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5371 VECTOR_MARK (ptr); /* Else mark it */
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5372 if (size & PSEUDOVECTOR_FLAG)
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5373 size &= PSEUDOVECTOR_SIZE_MASK;
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
5374
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5375 /* Note that this size is not the memory-footprint size, but only
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5376 the number of Lisp_Object fields that we should trace.
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5377 The distinction is used e.g. by Lisp_Process which places extra
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5378 non-Lisp_Object fields at the end of the structure. */
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5379 for (i = 0; i < size; i++) /* and then mark its elements */
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5380 mark_object (ptr->contents[i]);
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5381 }
46833
b80760a75295 (mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents: 46459
diff changeset
5382
104582
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5383 /* Like mark_vectorlike but optimized for char-tables (and
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5384 sub-char-tables) assuming that the contents are mostly integers or
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5385 symbols. */
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5386
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5387 static void
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5388 mark_char_table (ptr)
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5389 struct Lisp_Vector *ptr;
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5390 {
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5391 register EMACS_INT size = ptr->size & PSEUDOVECTOR_SIZE_MASK;
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5392 register int i;
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5393
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5394 eassert (!VECTOR_MARKED_P (ptr));
104582
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5395 VECTOR_MARK (ptr);
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5396 for (i = 0; i < size; i++)
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5397 {
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5398 Lisp_Object val = ptr->contents[i];
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5399
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5400 if (INTEGERP (val) || SYMBOLP (val) && XSYMBOL (val)->gcmarkbit)
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5401 continue;
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5402 if (SUB_CHAR_TABLE_P (val))
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5403 {
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5404 if (! VECTOR_MARKED_P (XVECTOR (val)))
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5405 mark_char_table (XVECTOR (val));
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5406 }
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5407 else
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5408 mark_object (val);
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5409 }
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5410 }
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5411
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5412 void
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5413 mark_object (arg)
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5414 Lisp_Object arg;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5415 {
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5416 register Lisp_Object obj = arg;
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5417 #ifdef GC_CHECK_MARKED_OBJECTS
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5418 void *po;
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5419 struct mem_node *m;
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5420 #endif
46833
b80760a75295 (mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents: 46459
diff changeset
5421 int cdr_count = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5422
5868
a7bd57a60cb8 (mark_object): Fetch obj from *objptr at loop, not at the gotos.
Karl Heuer <kwzh@gnu.org>
parents: 5353
diff changeset
5423 loop:
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5424
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
5425 if (PURE_POINTER_P (XPNTR (obj)))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5426 return;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5427
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5428 last_marked[last_marked_index++] = obj;
1168
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
5429 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
5430 last_marked_index = 0;
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
5431
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5432 /* 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
5433 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
5434 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
5435 #ifdef GC_CHECK_MARKED_OBJECTS
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5436
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5437 po = (void *) XPNTR (obj);
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5438
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5439 /* 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
5440 structure allocated from the heap. */
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5441 #define CHECK_ALLOCATED() \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5442 do { \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5443 m = mem_find (po); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5444 if (m == MEM_NIL) \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5445 abort (); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5446 } while (0)
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5447
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5448 /* 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
5449 function LIVEP. */
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5450 #define CHECK_LIVE(LIVEP) \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5451 do { \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5452 if (!LIVEP (m, po)) \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5453 abort (); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5454 } while (0)
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5455
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5456 /* 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
5457 #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
5458 do { \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5459 CHECK_ALLOCATED (); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5460 CHECK_LIVE (LIVEP); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5461 } while (0) \
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
5462
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5463 #else /* not GC_CHECK_MARKED_OBJECTS */
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
5464
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5465 #define CHECK_ALLOCATED() (void) 0
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5466 #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
5467 #define CHECK_ALLOCATED_AND_LIVE(LIVEP) (void) 0
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
5468
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5469 #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
5470
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
5471 switch (SWITCH_ENUM_CAST (XTYPE (obj)))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5472 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5473 case Lisp_String:
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5474 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5475 register struct Lisp_String *ptr = XSTRING (obj);
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5476 if (STRING_MARKED_P (ptr))
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5477 break;
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5478 CHECK_ALLOCATED_AND_LIVE (live_string_p);
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5479 MARK_INTERVAL_TREE (ptr->intervals);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5480 MARK_STRING (ptr);
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
5481 #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
5482 /* 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
5483 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
5484 CHECK_STRING_BYTES (ptr);
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
5485 #endif /* GC_CHECK_STRING_BYTES */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5486 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5487 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5488
10009
82f3daf76995 (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 10004
diff changeset
5489 case Lisp_Vectorlike:
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5490 if (VECTOR_MARKED_P (XVECTOR (obj)))
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5491 break;
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5492 #ifdef GC_CHECK_MARKED_OBJECTS
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5493 m = mem_find (po);
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
5494 if (m == MEM_NIL && !SUBRP (obj)
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5495 && po != &buffer_defaults
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5496 && po != &buffer_local_symbols)
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5497 abort ();
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5498 #endif /* GC_CHECK_MARKED_OBJECTS */
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
5499
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
5500 if (BUFFERP (obj))
10340
ef58c7a5a4d6 (mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents: 10320
diff changeset
5501 {
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5502 #ifdef GC_CHECK_MARKED_OBJECTS
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5503 if (po != &buffer_defaults && po != &buffer_local_symbols)
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5504 {
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5505 struct buffer *b;
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5506 for (b = all_buffers; b && b != po; b = b->next)
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5507 ;
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5508 if (b == NULL)
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5509 abort ();
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5510 }
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5511 #endif /* GC_CHECK_MARKED_OBJECTS */
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5512 mark_buffer (obj);
10340
ef58c7a5a4d6 (mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents: 10320
diff changeset
5513 }
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
5514 else if (SUBRP (obj))
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
5515 break;
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
5516 else if (COMPILEDP (obj))
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5517 /* 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
5518 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
5519 recursion there. */
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
5520 {
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
5521 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
5522 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
5523 register int i;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5524
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5525 CHECK_LIVE (live_vector_p);
51683
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
5526 VECTOR_MARK (ptr); /* Else mark it */
10009
82f3daf76995 (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 10004
diff changeset
5527 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
5528 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
5529 {
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
5530 if (i != COMPILED_CONSTANTS)
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5531 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
5532 }
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5533 obj = 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
5534 goto loop;
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
5535 }
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
5536 else if (FRAMEP (obj))
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
5537 {
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
5538 register struct frame *ptr = XFRAME (obj);
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5539 mark_vectorlike (XVECTOR (obj));
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5540 mark_face_cache (ptr->face_cache);
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
5541 }
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
5542 else if (WINDOWP (obj))
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5543 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5544 register struct Lisp_Vector *ptr = XVECTOR (obj);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5545 struct window *w = XWINDOW (obj);
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5546 mark_vectorlike (ptr);
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5547 /* Mark glyphs for leaf windows. Marking window matrices is
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5548 sufficient because frame matrices use the same glyph
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5549 memory. */
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5550 if (NILP (w->hchild)
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5551 && NILP (w->vchild)
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5552 && w->current_matrix)
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5553 {
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5554 mark_glyph_matrix (w->current_matrix);
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5555 mark_glyph_matrix (w->desired_matrix);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5556 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5557 }
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
5558 else if (HASH_TABLE_P (obj))
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5559 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5560 struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5561 mark_vectorlike ((struct Lisp_Vector *)h);
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5562 /* If hash table is not weak, mark all keys and values.
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5563 For weak tables, mark only the vector. */
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5564 if (NILP (h->weak))
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5565 mark_object (h->key_and_value);
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5566 else
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5567 VECTOR_MARK (XVECTOR (h->key_and_value));
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5568 }
104582
7d47cb148b29 (mark_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 104313
diff changeset
5569 else if (CHAR_TABLE_P (obj))
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5570 mark_char_table (XVECTOR (obj));
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
5571 else
85019
21a145f18ed2 (allocate_pseudovector): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84978
diff changeset
5572 mark_vectorlike (XVECTOR (obj));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5573 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5574
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5575 case Lisp_Symbol:
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5576 {
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
5577 register struct Lisp_Symbol *ptr = XSYMBOL (obj);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5578 struct Lisp_Symbol *ptrx;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5579
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5580 if (ptr->gcmarkbit)
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5581 break;
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5582 CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
5583 ptr->gcmarkbit = 1;
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5584 mark_object (ptr->function);
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5585 mark_object (ptr->plist);
107984
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5586 switch (ptr->redirect)
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5587 {
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5588 case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break;
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5589 case SYMBOL_VARALIAS:
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5590 {
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5591 Lisp_Object tem;
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5592 XSETSYMBOL (tem, SYMBOL_ALIAS (ptr));
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5593 mark_object (tem);
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5594 break;
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5595 }
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5596 case SYMBOL_LOCALIZED:
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5597 {
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5598 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr);
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5599 /* If the value is forwarded to a buffer or keyboard field,
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5600 these are marked when we see the corresponding object.
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5601 And if it's forwarded to a C variable, either it's not
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5602 a Lisp_Object var, or it's staticpro'd already. */
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5603 mark_object (blv->where);
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5604 mark_object (blv->valcell);
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5605 mark_object (blv->defcell);
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5606 break;
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5607 }
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5608 case SYMBOL_FORWARDED:
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5609 /* If the value is forwarded to a buffer or keyboard field,
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5610 these are marked when we see the corresponding object.
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5611 And if it's forwarded to a C variable, either it's not
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5612 a Lisp_Object var, or it's staticpro'd already. */
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5613 break;
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5614 default: abort ();
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
5615 }
45392
f3d7ab65641f * alloc.c (Fmake_symbol): Set symbol xname field instead of name.
Ken Raeburn <raeburn@raeburn.org>
parents: 44890
diff changeset
5616 if (!PURE_POINTER_P (XSTRING (ptr->xname)))
f3d7ab65641f * alloc.c (Fmake_symbol): Set symbol xname field instead of name.
Ken Raeburn <raeburn@raeburn.org>
parents: 44890
diff changeset
5617 MARK_STRING (XSTRING (ptr->xname));
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46305
diff changeset
5618 MARK_INTERVAL_TREE (STRING_INTERVALS (ptr->xname));
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
5619
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5620 ptr = ptr->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5621 if (ptr)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5622 {
2507
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
5623 ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5624 XSETSYMBOL (obj, ptrx);
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5625 goto loop;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5626 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5627 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5628 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5629
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
5630 case Lisp_Misc:
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5631 CHECK_ALLOCATED_AND_LIVE (live_misc_p);
85328
d0d527210b0c * lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85023
diff changeset
5632 if (XMISCANY (obj)->gcmarkbit)
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
5633 break;
85328
d0d527210b0c * lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85023
diff changeset
5634 XMISCANY (obj)->gcmarkbit = 1;
56202
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5635
11243
054ecfce1820 (Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11048
diff changeset
5636 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
5637 {
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5638
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
5639 case Lisp_Misc_Marker:
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
5640 /* DO NOT mark thru the marker's chain.
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
5641 The buffer's markers chain does not preserve markers from gc;
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
5642 instead, markers are removed from the chain when freed by gc. */
56202
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5643 break;
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5644
52166
25f780eb3fd8 (mark_object): Handle Lisp_Misc_Save_Value.
Andreas Schwab <schwab@suse.de>
parents: 51985
diff changeset
5645 case Lisp_Misc_Save_Value:
56401
1529ab7bab88 (mark_object): Only look at Lisp_Misc_Save_Value if GC_MARK_STACK.
Kim F. Storm <storm@cua.dk>
parents: 56239
diff changeset
5646 #if GC_MARK_STACK
56202
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5647 {
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5648 register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj);
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5649 /* If DOGC is set, POINTER is the address of a memory
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5650 area containing INTEGER potential Lisp_Objects. */
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5651 if (ptr->dogc)
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5652 {
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5653 Lisp_Object *p = (Lisp_Object *) ptr->pointer;
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5654 int nelt;
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5655 for (nelt = ptr->integer; nelt > 0; nelt--, p++)
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5656 mark_maybe_object (*p);
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5657 }
db1817b88294 (safe_alloca_unwind): Clear dogc and pointer members.
Kim F. Storm <storm@cua.dk>
parents: 56187
diff changeset
5658 }
56401
1529ab7bab88 (mark_object): Only look at Lisp_Misc_Save_Value if GC_MARK_STACK.
Kim F. Storm <storm@cua.dk>
parents: 56239
diff changeset
5659 #endif
9463
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
5660 break;
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
5661
9926
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
5662 case Lisp_Misc_Overlay:
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
5663 {
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
5664 struct Lisp_Overlay *ptr = XOVERLAY (obj);
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5665 mark_object (ptr->start);
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5666 mark_object (ptr->end);
51843
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5667 mark_object (ptr->plist);
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5668 if (ptr->next)
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5669 {
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5670 XSETMISC (obj, ptr->next);
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5671 goto loop;
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5672 }
9926
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
5673 }
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
5674 break;
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
5675
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
5676 default:
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
5677 abort ();
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
5678 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5679 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5680
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5681 case Lisp_Cons:
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5682 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5683 register struct Lisp_Cons *ptr = XCONS (obj);
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5684 if (CONS_MARKED_P (ptr))
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5685 break;
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5686 CHECK_ALLOCATED_AND_LIVE (live_cons_p);
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
5687 CONS_MARK (ptr);
1295
a9241dc503ab (mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents: 1168
diff changeset
5688 /* If the cdr is nil, avoid recursion for the car. */
66889
e485868e3caf (free_float): Make free list chaining aliasing-safe.
Andreas Schwab <schwab@suse.de>
parents: 66777
diff changeset
5689 if (EQ (ptr->u.cdr, Qnil))
1295
a9241dc503ab (mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents: 1168
diff changeset
5690 {
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5691 obj = ptr->car;
46833
b80760a75295 (mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents: 46459
diff changeset
5692 cdr_count = 0;
1295
a9241dc503ab (mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents: 1168
diff changeset
5693 goto loop;
a9241dc503ab (mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents: 1168
diff changeset
5694 }
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5695 mark_object (ptr->car);
66889
e485868e3caf (free_float): Make free list chaining aliasing-safe.
Andreas Schwab <schwab@suse.de>
parents: 66777
diff changeset
5696 obj = ptr->u.cdr;
46833
b80760a75295 (mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents: 46459
diff changeset
5697 cdr_count++;
b80760a75295 (mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents: 46459
diff changeset
5698 if (cdr_count == mark_object_loop_halt)
b80760a75295 (mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents: 46459
diff changeset
5699 abort ();
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5700 goto loop;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5701 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5702
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5703 case Lisp_Float:
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5704 CHECK_ALLOCATED_AND_LIVE (live_float_p);
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
5705 FLOAT_MARK (XFLOAT (obj));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5706 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5707
105885
8103235103a7 Let integers use up 2 tags to give them one extra bit and double their range.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105881
diff changeset
5708 case_Lisp_Int:
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5709 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5710
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5711 default:
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5712 abort ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5713 }
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5714
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5715 #undef CHECK_LIVE
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5716 #undef CHECK_ALLOCATED
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
5717 #undef CHECK_ALLOCATED_AND_LIVE
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5718 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5719
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5720 /* Mark the pointers in a buffer structure. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5721
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5722 static void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5723 mark_buffer (buf)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5724 Lisp_Object buf;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5725 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5726 register struct buffer *buffer = XBUFFER (buf);
51843
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5727 register Lisp_Object *ptr, tmp;
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
5728 Lisp_Object base_buffer;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5729
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5730 eassert (!VECTOR_MARKED_P (buffer));
51683
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
5731 VECTOR_MARK (buffer);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5732
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
5733 MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5734
55816
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5735 /* For now, we just don't mark the undo_list. It's done later in
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5736 a special way just before the sweep phase, and after stripping
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5737 some of its elements that are not needed any more. */
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
5738
51843
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5739 if (buffer->overlays_before)
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5740 {
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5741 XSETMISC (tmp, buffer->overlays_before);
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5742 mark_object (tmp);
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5743 }
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5744 if (buffer->overlays_after)
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5745 {
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5746 XSETMISC (tmp, buffer->overlays_after);
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5747 mark_object (tmp);
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5748 }
65772ad7d4e1 (mark_object): Mark the new `next' field of overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51788
diff changeset
5749
91780
d097bc79fdfb (mark_buffer): Comment fix to clarify the status of Lisp fields.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91367
diff changeset
5750 /* buffer-local Lisp variables start at `undo_list',
d097bc79fdfb (mark_buffer): Comment fix to clarify the status of Lisp fields.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91367
diff changeset
5751 tho only the ones from `name' on are GC'd normally. */
51683
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
5752 for (ptr = &buffer->name;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5753 (char *)ptr < (char *)buffer + sizeof (struct buffer);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5754 ptr++)
51770
ad47aa3ee2d7 (mark_object): Change arg to only take Lisp_Object rather than *Lisp_Object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51758
diff changeset
5755 mark_object (*ptr);
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
5756
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
5757 /* If this is an indirect buffer, mark its base buffer. */
51686
17c015f1f795 (mark_buffer): Fix missed buffer->name in last patch.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51683
diff changeset
5758 if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
5759 {
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
5760 XSETBUFFER (base_buffer, buffer->base_buffer);
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
5761 mark_buffer (base_buffer);
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
5762 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5763 }
10649
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
5764
84693
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
5765 /* Mark the Lisp pointers in the terminal objects.
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
5766 Called by the Fgarbage_collector. */
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
5767
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
5768 static void
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
5769 mark_terminals (void)
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
5770 {
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
5771 struct terminal *t;
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
5772 for (t = terminal_list; t; t = t->next_terminal)
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
5773 {
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
5774 eassert (t->name != NULL);
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5775 if (!VECTOR_MARKED_P (t))
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5776 {
92109
4d9fc08769fa Consolidate the image_cache to the terminal struct.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91780
diff changeset
5777 #ifdef HAVE_WINDOW_SYSTEM
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5778 mark_image_cache (t->image_cache);
92109
4d9fc08769fa Consolidate the image_cache to the terminal struct.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91780
diff changeset
5779 #endif /* HAVE_WINDOW_SYSTEM */
105986
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5780 mark_vectorlike ((struct Lisp_Vector *)t);
850debe3a245 (mark_object): Don't reprocess marked strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105958
diff changeset
5781 }
84693
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
5782 }
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
5783 }
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
5784
7ee574475f20 (enum mem_type): New member for `terminal' objects.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 84602
diff changeset
5785
10649
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
5786
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5787 /* 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
5788 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
5789
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5790 int
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5791 survives_gc_p (obj)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5792 Lisp_Object obj;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5793 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5794 int survives_p;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
5795
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
5796 switch (XTYPE (obj))
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5797 {
105885
8103235103a7 Let integers use up 2 tags to give them one extra bit and double their range.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105881
diff changeset
5798 case_Lisp_Int:
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5799 survives_p = 1;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5800 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5801
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5802 case Lisp_Symbol:
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
5803 survives_p = XSYMBOL (obj)->gcmarkbit;
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5804 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5805
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5806 case Lisp_Misc:
85328
d0d527210b0c * lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85023
diff changeset
5807 survives_p = XMISCANY (obj)->gcmarkbit;
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5808 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5809
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5810 case Lisp_String:
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
5811 survives_p = STRING_MARKED_P (XSTRING (obj));
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5812 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5813
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5814 case Lisp_Vectorlike:
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
5815 survives_p = SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj));
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5816 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5817
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5818 case Lisp_Cons:
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
5819 survives_p = CONS_MARKED_P (XCONS (obj));
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5820 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5821
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5822 case Lisp_Float:
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
5823 survives_p = FLOAT_MARKED_P (XFLOAT (obj));
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5824 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5825
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5826 default:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5827 abort ();
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5828 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5829
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5830 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
5831 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5832
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5833
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5834
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
5835 /* Sweep: find all structures not marked, and free them. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5836
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5837 static void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5838 gc_sweep ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5839 {
55816
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5840 /* Remove or mark entries in weak hash tables.
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5841 This must be done before any object is unmarked. */
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5842 sweep_weak_hash_tables ();
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5843
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5844 sweep_strings ();
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5845 #ifdef GC_CHECK_STRING_BYTES
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5846 if (!noninteractive)
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5847 check_string_bytes (1);
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5848 #endif
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
5849
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5850 /* Put all unmarked conses on free list */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5851 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5852 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
5853 struct cons_block **cprev = &cons_block;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5854 register int lim = cons_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5855 register int num_free = 0, num_used = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5856
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5857 cons_free_list = 0;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
5858
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5859 for (cblk = cons_block; cblk; cblk = *cprev)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5860 {
84816
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5861 register int i = 0;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5862 int this_free = 0;
84816
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5863 int ilim = (lim + BITS_PER_INT - 1) / BITS_PER_INT;
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5864
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5865 /* Scan the mark bits an int at a time. */
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5866 for (i = 0; i <= ilim; i++)
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5867 {
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5868 if (cblk->gcmarkbits[i] == -1)
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5869 {
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5870 /* Fast path - all cons cells for this int are marked. */
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5871 cblk->gcmarkbits[i] = 0;
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5872 num_used += BITS_PER_INT;
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5873 }
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5874 else
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5875 {
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5876 /* Some cons cells for this int are not marked.
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5877 Find which ones, and free them. */
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5878 int start, pos, stop;
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5879
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5880 start = i * BITS_PER_INT;
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5881 stop = lim - start;
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5882 if (stop > BITS_PER_INT)
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5883 stop = BITS_PER_INT;
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5884 stop += start;
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5885
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5886 for (pos = start; pos < stop; pos++)
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5887 {
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5888 if (!CONS_MARKED_P (&cblk->conses[pos]))
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5889 {
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5890 this_free++;
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5891 cblk->conses[pos].u.chain = cons_free_list;
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5892 cons_free_list = &cblk->conses[pos];
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5893 #if GC_MARK_STACK
84816
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5894 cons_free_list->car = Vdead;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5895 #endif
84816
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5896 }
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5897 else
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5898 {
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5899 num_used++;
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5900 CONS_UNMARK (&cblk->conses[pos]);
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5901 }
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5902 }
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5903 }
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5904 }
4d1c866492b0 (gc_sweep): Check cons cell mark bits word by word
Richard M. Stallman <rms@gnu.org>
parents: 84693
diff changeset
5905
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5906 lim = CONS_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5907 /* 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
5908 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
5909 this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5910 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
5911 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5912 *cprev = cblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5913 /* Unhook from the free list. */
66889
e485868e3caf (free_float): Make free list chaining aliasing-safe.
Andreas Schwab <schwab@suse.de>
parents: 66777
diff changeset
5914 cons_free_list = cblk->conses[0].u.chain;
51938
20d4eb1de9b0 Use bitmaps for cons cells, as was done for floats.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51908
diff changeset
5915 lisp_align_free (cblk);
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
5916 n_cons_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5917 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5918 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5919 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5920 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5921 cprev = &cblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5922 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5923 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5924 total_conses = num_used;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5925 total_free_conses = num_free;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5926 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5927
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5928 /* Put all unmarked floats on free list */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5929 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5930 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
5931 struct float_block **fprev = &float_block;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5932 register int lim = float_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5933 register int num_free = 0, num_used = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5934
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5935 float_free_list = 0;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
5936
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5937 for (fblk = float_block; fblk; fblk = *fprev)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5938 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5939 register int i;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5940 int this_free = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5941 for (i = 0; i < lim; i++)
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
5942 if (!FLOAT_MARKED_P (&fblk->floats[i]))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5943 {
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5944 this_free++;
66889
e485868e3caf (free_float): Make free list chaining aliasing-safe.
Andreas Schwab <schwab@suse.de>
parents: 66777
diff changeset
5945 fblk->floats[i].u.chain = float_free_list;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5946 float_free_list = &fblk->floats[i];
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5947 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5948 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5949 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5950 num_used++;
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
5951 FLOAT_UNMARK (&fblk->floats[i]);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5952 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5953 lim = FLOAT_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5954 /* 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
5955 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
5956 this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5957 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
5958 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5959 *fprev = fblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5960 /* Unhook from the free list. */
66889
e485868e3caf (free_float): Make free list chaining aliasing-safe.
Andreas Schwab <schwab@suse.de>
parents: 66777
diff changeset
5961 float_free_list = fblk->floats[0].u.chain;
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
5962 lisp_align_free (fblk);
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
5963 n_float_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5964 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5965 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5966 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5967 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5968 fprev = &fblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5969 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5970 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5971 total_floats = num_used;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5972 total_free_floats = num_free;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5973 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5974
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5975 /* Put all unmarked intervals on free list */
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5976 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5977 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
5978 struct interval_block **iprev = &interval_block;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5979 register int lim = interval_block_index;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5980 register int num_free = 0, num_used = 0;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5981
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5982 interval_free_list = 0;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5983
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5984 for (iblk = interval_block; iblk; iblk = *iprev)
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5985 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5986 register int i;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5987 int this_free = 0;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5988
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5989 for (i = 0; i < lim; i++)
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5990 {
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
5991 if (!iblk->intervals[i].gcmarkbit)
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5992 {
28269
fd13be8ae190 Changes towards better type safety regarding intervals, primarily
Ken Raeburn <raeburn@raeburn.org>
parents: 28220
diff changeset
5993 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
5994 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
5995 this_free++;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5996 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5997 else
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5998 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5999 num_used++;
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
6000 iblk->intervals[i].gcmarkbit = 0;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
6001 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
6002 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
6003 lim = INTERVAL_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6004 /* 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
6005 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
6006 deallocate this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6007 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
6008 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6009 *iprev = iblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6010 /* Unhook from the free list. */
28269
fd13be8ae190 Changes towards better type safety regarding intervals, primarily
Ken Raeburn <raeburn@raeburn.org>
parents: 28220
diff changeset
6011 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
6012 lisp_free (iblk);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
6013 n_interval_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6014 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6015 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6016 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6017 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6018 iprev = &iblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6019 }
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
6020 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
6021 total_intervals = num_used;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
6022 total_free_intervals = num_free;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
6023 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
6024
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6025 /* Put all unmarked symbols on free list */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6026 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6027 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
6028 struct symbol_block **sprev = &symbol_block;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6029 register int lim = symbol_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6030 register int num_free = 0, num_used = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6031
34308
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6032 symbol_free_list = NULL;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
6033
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6034 for (sblk = symbol_block; sblk; sblk = *sprev)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6035 {
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6036 int this_free = 0;
34308
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6037 struct Lisp_Symbol *sym = sblk->symbols;
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6038 struct Lisp_Symbol *end = sym + lim;
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6039
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6040 for (; sym < end; ++sym)
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6041 {
34325
a65d8c29442a (gc_sweep): Add comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 34308
diff changeset
6042 /* 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
6043 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
6044 so we conservatively assume that it is live. */
45392
f3d7ab65641f * alloc.c (Fmake_symbol): Set symbol xname field instead of name.
Ken Raeburn <raeburn@raeburn.org>
parents: 44890
diff changeset
6045 int pure_p = PURE_POINTER_P (XSTRING (sym->xname));
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
6046
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
6047 if (!sym->gcmarkbit && !pure_p)
34308
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6048 {
107984
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
6049 if (sym->redirect == SYMBOL_LOCALIZED)
bef5d1738c0b Make variable forwarding explicit rather the using special values.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107895
diff changeset
6050 xfree (SYMBOL_BLV (sym));
66889
e485868e3caf (free_float): Make free list chaining aliasing-safe.
Andreas Schwab <schwab@suse.de>
parents: 66777
diff changeset
6051 sym->next = symbol_free_list;
34308
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6052 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
6053 #if GC_MARK_STACK
34308
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6054 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
6055 #endif
34308
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6056 ++this_free;
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6057 }
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6058 else
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6059 {
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6060 ++num_used;
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6061 if (!pure_p)
45392
f3d7ab65641f * alloc.c (Fmake_symbol): Set symbol xname field instead of name.
Ken Raeburn <raeburn@raeburn.org>
parents: 44890
diff changeset
6062 UNMARK_STRING (XSTRING (sym->xname));
51658
00b3e009b3f5 (make_interval, Fmake_symbol, allocate_misc):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51578
diff changeset
6063 sym->gcmarkbit = 0;
34308
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6064 }
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
6065 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
6066
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6067 lim = SYMBOL_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6068 /* 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
6069 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
6070 this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6071 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
6072 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6073 *sprev = sblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6074 /* Unhook from the free list. */
66889
e485868e3caf (free_float): Make free list chaining aliasing-safe.
Andreas Schwab <schwab@suse.de>
parents: 66777
diff changeset
6075 symbol_free_list = sblk->symbols[0].next;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
6076 lisp_free (sblk);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
6077 n_symbol_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6078 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6079 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6080 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6081 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6082 sprev = &sblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6083 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6084 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6085 total_symbols = num_used;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6086 total_free_symbols = num_free;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6087 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6088
21143
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
6089 /* 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
6090 For a marker, first unchain it from the buffer it points into. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6091 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6092 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
6093 struct marker_block **mprev = &marker_block;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6094 register int lim = marker_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6095 register int num_free = 0, num_used = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6096
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6097 marker_free_list = 0;
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
6098
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6099 for (mblk = marker_block; mblk; mblk = *mprev)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6100 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6101 register int i;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6102 int this_free = 0;
11403
bd3241a14d0a (gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents: 11374
diff changeset
6103
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6104 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
6105 {
85344
99492f857499 (free_misc): Use XMISCTYPE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85329
diff changeset
6106 if (!mblk->markers[i].u_any.gcmarkbit)
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
6107 {
85344
99492f857499 (free_misc): Use XMISCTYPE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85329
diff changeset
6108 if (mblk->markers[i].u_any.type == Lisp_Misc_Marker)
51668
0f333fd92a1d (survives_gc_p): Simplify.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51658
diff changeset
6109 unchain_marker (&mblk->markers[i].u_marker);
11403
bd3241a14d0a (gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents: 11374
diff changeset
6110 /* 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
6111 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
6112 but this might catch bugs faster. */
11243
054ecfce1820 (Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11048
diff changeset
6113 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
6114 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
6115 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
6116 this_free++;
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
6117 }
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
6118 else
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
6119 {
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
6120 num_used++;
85344
99492f857499 (free_misc): Use XMISCTYPE.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85329
diff changeset
6121 mblk->markers[i].u_any.gcmarkbit = 0;
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
6122 }
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
6123 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6124 lim = MARKER_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6125 /* 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
6126 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
6127 this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6128 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
6129 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6130 *mprev = mblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6131 /* Unhook from the free list. */
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6132 marker_free_list = mblk->markers[0].u_free.chain;
55816
a4fe04f4d9c2 Undo Kim's recent changes and fix the same bug differently.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55798
diff changeset
6133 lisp_free (mblk);
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
6134 n_marker_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6135 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
6136 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6137 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6138 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6139 mprev = &mblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
6140 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6141 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6142
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6143 total_markers = num_used;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6144 total_free_markers = num_free;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6145 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6146
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6147 /* Free all unmarked buffers */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6148 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6149 register struct buffer *buffer = all_buffers, *prev = 0, *next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6150
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6151 while (buffer)
51683
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
6152 if (!VECTOR_MARKED_P (buffer))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6153 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6154 if (prev)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6155 prev->next = buffer->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6156 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6157 all_buffers = buffer->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6158 next = buffer->next;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
6159 lisp_free (buffer);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6160 buffer = next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6161 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6162 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6163 {
51683
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
6164 VECTOR_UNMARK (buffer);
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
6165 UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6166 prev = buffer, buffer = buffer->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6167 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6168 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6169
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6170 /* Free all unmarked vectors */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6171 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6172 register struct Lisp_Vector *vector = all_vectors, *prev = 0, *next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6173 total_vector_size = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6174
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6175 while (vector)
51683
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
6176 if (!VECTOR_MARKED_P (vector))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6177 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6178 if (prev)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6179 prev->next = vector->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6180 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6181 all_vectors = vector->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6182 next = vector->next;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
6183 lisp_free (vector);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
6184 n_vectors--;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6185 vector = next;
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
6186
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6187 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6188 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6189 {
51683
fb960854a12c (VECTOR_MARK, VECTOR_UNMARK, VECTOR_MARKED_P): New macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51668
diff changeset
6190 VECTOR_UNMARK (vector);
11403
bd3241a14d0a (gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents: 11374
diff changeset
6191 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
6192 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
6193 else
bd3241a14d0a (gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents: 11374
diff changeset
6194 total_vector_size += vector->size;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6195 prev = vector, vector = vector->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6196 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6197 }
49600
23a1cea22d13 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49529
diff changeset
6198
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
6199 #ifdef GC_CHECK_STRING_BYTES
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
6200 if (!noninteractive)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
6201 check_string_bytes (1);
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
6202 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6203 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
6204
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
6205
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
6206
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6207
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
6208 /* Debugging aids. */
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
6209
5353
6389ed5b45ac (Fmemory_limit): No longer interactive.
Richard M. Stallman <rms@gnu.org>
parents: 4956
diff changeset
6210 DEFUN ("memory-limit", Fmemory_limit, Smemory_limit, 0, 0, 0,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6211 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
6212 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
6213 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
6214 ()
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
6215 {
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
6216 Lisp_Object end;
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
6217
9261
e5ba7993d378 (VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents: 9144
diff changeset
6218 XSETINT (end, (EMACS_INT) sbrk (0) / 1024);
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
6219
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
6220 return end;
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
6221 }
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
6222
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
6223 DEFUN ("memory-use-counts", Fmemory_use_counts, Smemory_use_counts, 0, 0, 0,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6224 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
6225 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
6226 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
6227 Garbage collection does not decrease them.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
6228 The elements of the value are as follows:
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
6229 (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
6230 All are in units of 1 = one object consed
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
6231 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
6232 objects consed.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
6233 MISCS include overlays, markers, and some internal types.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
6234 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
6235 (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
6236 ()
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
6237 {
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
6238 Lisp_Object consed[8];
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
6239
39633
a0bf0cb8ff3e (inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents: 39572
diff changeset
6240 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
6241 consed[1] = make_number (min (MOST_POSITIVE_FIXNUM, floats_consed));
a0bf0cb8ff3e (inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents: 39572
diff changeset
6242 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
6243 consed[3] = make_number (min (MOST_POSITIVE_FIXNUM, symbols_consed));
a0bf0cb8ff3e (inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents: 39572
diff changeset
6244 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
6245 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
6246 consed[6] = make_number (min (MOST_POSITIVE_FIXNUM, intervals_consed));
a0bf0cb8ff3e (inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents: 39572
diff changeset
6247 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
6248
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
6249 return Flist (8, consed);
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
6250 }
28406
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
6251
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
6252 int suppress_checking;
85674
01258ecfc38e (spare_memory, stack_copy, stack_copy_size, ignore_warnings, Vdead,
Juanma Barranquero <lekktu@gmail.com>
parents: 85344
diff changeset
6253
28406
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
6254 void
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
6255 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
6256 const char *msg;
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
6257 const char *file;
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
6258 int line;
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
6259 {
85328
d0d527210b0c * lisp.h (enum Lisp_Misc_Type): Del Lisp_Misc_Some_Buffer_Local_Value.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85023
diff changeset
6260 fprintf (stderr, "\r\n%s:%d: Emacs fatal error: %s\r\n",
28406
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
6261 file, line, msg);
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
6262 abort ();
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
6263 }
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
6264
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6265 /* Initialization */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6266
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21379
diff changeset
6267 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6268 init_alloc_once ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6269 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6270 /* 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
6271 purebeg = PUREBEG;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
6272 pure_size = PURESIZE;
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
6273 pure_bytes_used = 0;
72027
107f9a044a0a (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 71967
diff changeset
6274 pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
6275 pure_bytes_used_before_overflow = 0;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
6276
51723
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
6277 /* Initialize the list of free aligned blocks. */
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
6278 free_ablock = NULL;
635066222916 (ALIGN): Add casts to simplify usage.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51686
diff changeset
6279
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
6280 #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
6281 mem_init ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
6282 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
6283 #endif
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
6284
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6285 all_vectors = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6286 ignore_warnings = 1;
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
6287 #ifdef DOUG_LEA_MALLOC
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
6288 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
6289 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
6290 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
6291 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6292 init_strings ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6293 init_cons ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6294 init_symbol ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6295 init_marker ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6296 init_float ();
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
6297 init_intervals ();
94993
b0b4e9fbfb37 (init_alloc_once): Call init_weak_hash_tables.
Chong Yidong <cyd@stupidchicken.com>
parents: 94963
diff changeset
6298 init_weak_hash_tables ();
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
6299
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
6300 #ifdef REL_ALLOC
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
6301 malloc_hysteresis = 32;
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
6302 #else
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
6303 malloc_hysteresis = 0;
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
6304 #endif
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
6305
66530
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
6306 refill_memory_reserve ();
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
6307
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6308 ignore_warnings = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6309 gcprolist = 0;
26364
7b0217d9259c (Fgarbage_collect): Call mark_byte_stack and
Gerd Moellmann <gerd@gnu.org>
parents: 26164
diff changeset
6310 byte_stack_list = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6311 staticidx = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6312 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
6313 gc_cons_threshold = 100000 * sizeof (Lisp_Object);
64611
47f158dcf216 (gc_cons_threshold): Not static.
Richard M. Stallman <rms@gnu.org>
parents: 64273
diff changeset
6314 gc_relative_threshold = 0;
47f158dcf216 (gc_cons_threshold): Not static.
Richard M. Stallman <rms@gnu.org>
parents: 64273
diff changeset
6315
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6316 #ifdef VIRT_ADDR_VARIES
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6317 malloc_sbrk_unused = 1<<22; /* A large number */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6318 malloc_sbrk_used = 100000; /* as reasonable as any number */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6319 #endif /* VIRT_ADDR_VARIES */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6320 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6321
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21379
diff changeset
6322 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6323 init_alloc ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6324 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6325 gcprolist = 0;
26364
7b0217d9259c (Fgarbage_collect): Call mark_byte_stack and
Gerd Moellmann <gerd@gnu.org>
parents: 26164
diff changeset
6326 byte_stack_list = 0;
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
6327 #if GC_MARK_STACK
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
6328 #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
6329 setjmp_tested_p = longjmps_done = 0;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
6330 #endif
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
6331 #endif
49529
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
6332 Vgc_elapsed = make_float (0.0);
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
6333 gcs_done = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6334 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6335
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6336 void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6337 syms_of_alloc ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6338 {
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6339 DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6340 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
6341 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
6342 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
6343
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
6344 Garbage collection happens automatically only when `eval' is called.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
6345
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
6346 By binding this temporarily to a large number, you can effectively
64267
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
6347 prevent garbage collection during a part of the program.
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
6348 See also `gc-cons-percentage'. */);
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
6349
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
6350 DEFVAR_LISP ("gc-cons-percentage", &Vgc_cons_percentage,
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
6351 doc: /* *Portion of the heap used for allocation.
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
6352 Garbage collection can happen automatically once this portion of the heap
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
6353 has been allocated since the last garbage collection.
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
6354 If this portion is smaller than `gc-cons-threshold', this is ignored. */);
5c7cbbd6dbb4 (gc_cons_combined_threshold, Vgc_cons_percentage): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 64084
diff changeset
6355 Vgc_cons_percentage = make_float (0.1);
39914
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
6356
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6357 DEFVAR_INT ("pure-bytes-used", &pure_bytes_used,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6358 doc: /* Number of bytes of sharable Lisp data allocated so far. */);
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6359
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6360 DEFVAR_INT ("cons-cells-consed", &cons_cells_consed,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6361 doc: /* Number of cons cells that have been consed so far. */);
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6362
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6363 DEFVAR_INT ("floats-consed", &floats_consed,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6364 doc: /* Number of floats that have been consed so far. */);
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6365
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6366 DEFVAR_INT ("vector-cells-consed", &vector_cells_consed,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6367 doc: /* Number of vector cells that have been consed so far. */);
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6368
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6369 DEFVAR_INT ("symbols-consed", &symbols_consed,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6370 doc: /* Number of symbols that have been consed so far. */);
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6371
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6372 DEFVAR_INT ("string-chars-consed", &string_chars_consed,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6373 doc: /* Number of string characters that have been consed so far. */);
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6374
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6375 DEFVAR_INT ("misc-objects-consed", &misc_objects_consed,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6376 doc: /* Number of miscellaneous objects that have been consed so far. */);
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6377
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6378 DEFVAR_INT ("intervals-consed", &intervals_consed,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6379 doc: /* Number of intervals that have been consed so far. */);
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6380
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6381 DEFVAR_INT ("strings-consed", &strings_consed,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6382 doc: /* Number of strings that have been consed so far. */);
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6383
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6384 DEFVAR_LISP ("purify-flag", &Vpurify_flag,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6385 doc: /* Non-nil means loading Lisp code in order to dump an executable.
107895
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
6386 This means that certain objects should be allocated in shared (pure) space.
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
6387 It can also be set to a hash-table, in which case this table is used to
265966b778f9 Hash-cons pure data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107435
diff changeset
6388 do hash-consing of the objects allocated to pure space. */);
39914
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
6389
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6390 DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6391 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
6392 garbage_collection_messages = 0;
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
6393
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
6394 DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook,
40107
d3cc7dd5d75a Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents: 39988
diff changeset
6395 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
6396 Vpost_gc_hook = Qnil;
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105871
diff changeset
6397 Qpost_gc_hook = intern_c_string ("post-gc-hook");
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
6398 staticpro (&Qpost_gc_hook);
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
6399
46305
fed6b815dbeb (Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 46293
diff changeset
6400 DEFVAR_LISP ("memory-signal-data", &Vmemory_signal_data,
fed6b815dbeb (Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 46293
diff changeset
6401 doc: /* Precomputed `signal' argument for memory-full error. */);
6116
64417bbbb128 (memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents: 5874
diff changeset
6402 /* 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
6403 not be able to allocate the memory to hold it. */
46305
fed6b815dbeb (Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 46293
diff changeset
6404 Vmemory_signal_data
105958
341a779db1d0 * frame.c (make_initial_frame):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105885
diff changeset
6405 = pure_cons (Qerror,
341a779db1d0 * frame.c (make_initial_frame):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105885
diff changeset
6406 pure_cons (make_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil));
46305
fed6b815dbeb (Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 46293
diff changeset
6407
fed6b815dbeb (Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 46293
diff changeset
6408 DEFVAR_LISP ("memory-full", &Vmemory_full,
66530
88aab29bf2b2 (syms_of_alloc) <memory-full>: Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66499
diff changeset
6409 doc: /* Non-nil means Emacs cannot get much more Lisp memory. */);
46305
fed6b815dbeb (Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 46293
diff changeset
6410 Vmemory_full = Qnil;
6116
64417bbbb128 (memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents: 5874
diff changeset
6411
11374
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
6412 staticpro (&Qgc_cons_threshold);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105871
diff changeset
6413 Qgc_cons_threshold = intern_c_string ("gc-cons-threshold");
11374
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
6414
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
6415 staticpro (&Qchar_table_extra_slots);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105871
diff changeset
6416 Qchar_table_extra_slots = intern_c_string ("char-table-extra-slots");
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
6417
49529
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
6418 DEFVAR_LISP ("gc-elapsed", &Vgc_elapsed,
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
6419 doc: /* Accumulated time elapsed in garbage collections.
51974
111cc76606c6 (syms_of_alloc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 51938
diff changeset
6420 The time is in seconds as a floating point value. */);
49529
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
6421 DEFVAR_INT ("gcs-done", &gcs_done,
51974
111cc76606c6 (syms_of_alloc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 51938
diff changeset
6422 doc: /* Accumulated number of garbage collections done. */);
49529
fd79b3081e01 (Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents: 49414
diff changeset
6423
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6424 defsubr (&Scons);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6425 defsubr (&Slist);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6426 defsubr (&Svector);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6427 defsubr (&Smake_byte_code);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6428 defsubr (&Smake_list);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6429 defsubr (&Smake_vector);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6430 defsubr (&Smake_string);
13141
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
6431 defsubr (&Smake_bool_vector);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6432 defsubr (&Smake_symbol);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6433 defsubr (&Smake_marker);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6434 defsubr (&Spurecopy);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6435 defsubr (&Sgarbage_collect);
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
6436 defsubr (&Smemory_limit);
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
6437 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
6438
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
6439 #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
6440 defsubr (&Sgc_status);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
6441 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6442 }
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 52276
diff changeset
6443
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 52276
diff changeset
6444 /* arch-tag: 6695ca10-e3c5-4c2c-8bc3-ed26a7dda857
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 52276
diff changeset
6445 (do not change this comment) */