annotate src/alloc.c @ 5160:ab9ee10a53e4

fix various problems with allocation statistics, track overhead properly -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-03-20 Ben Wing <ben@xemacs.org> * diagnose.el (show-memory-usage): * diagnose.el (show-object-memory-usage-stats): Further changes to correspond with changes in the C code; add an additional column showing the overhead used with each type, and add it into the grand total memory usage. src/ChangeLog addition: 2010-03-20 Ben Wing <ben@xemacs.org> * alloc.c: * alloc.c (init_lrecord_stats): * alloc.c (free_normal_lisp_object): * alloc.c (struct): * alloc.c (clear_lrecord_stats): * alloc.c (tick_lrecord_stats): * alloc.c (COUNT_FROB_BLOCK_USAGE): * alloc.c (COPY_INTO_LRECORD_STATS): * alloc.c (sweep_strings): * alloc.c (UNMARK_string): * alloc.c (gc_sweep_1): * alloc.c (finish_object_memory_usage_stats): * alloc.c (object_memory_usage_stats): * alloc.c (object_dead_p): * alloc.c (fixed_type_block_overhead): * alloc.c (lisp_object_storage_size): * emacs.c (main_1): * lisp.h: * lrecord.h: Export lisp_object_storage_size() and malloced_storage_size() even when not MEMORY_USAGE_STATS, to get the non-MEMORY_USAGE_STATS build to compile. Don't export fixed_type_block_overhead() any more. Some code cleanup, rearrangement, add some section headers. Clean up various bugs especially involving computation of overhead and double-counting certain usage in total_gc_usage. Add statistics computing the overhead used by all types. Don't add a special entry for string headers in the object-memory-usage-stats because it's already present as just "string". But do count the overhead used by long strings. Don't try to call the memory_usage() methods when NEW_GC because there's nowhere obvious in the sweep stage to make the calls. * marker.c (compute_buffer_marker_usage): Just use lisp_object_storage_size() rather than trying to reimplement it.
author Ben Wing <ben@xemacs.org>
date Sat, 20 Mar 2010 20:20:30 -0500
parents cb303ff63e76
children 57f4dcb14ad5 e374ea766cc1
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Storage allocation and gc for XEmacs Lisp interpreter.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985-1998 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1995 Sun Microsystems, Inc.
4880
ae81a2c00f4f try harder to avoid crashing when debug-printing
Ben Wing <ben@xemacs.org>
parents: 4803
diff changeset
4 Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005, 2010 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Synched up with: FSF 19.28, Mule 2.0. Substantially different from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 /* Authorship:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 FSF: Original version; a long time ago.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 Mly: Significantly rewritten to use new 3-bit tags and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 nicely abstracted object definitions, for 19.8.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 JWZ: Improved code to keep track of purespace usage and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 issue nice purespace and GC stats.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 Ben Wing: Cleaned up frob-block lrecord code, added error-checking
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 and various changes for Mule, for 19.12.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 Added bit vectors for 19.13.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 Added lcrecord lists for 19.14.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 slb: Lots of work on the purification and dump time code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 Synched Doug Lea malloc support from Emacs 20.2.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
39 og: Killed the purespace. Portable dumper (moved to dumper.c)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #include "backtrace.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #include "chartab.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #include "device.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 #include "elhash.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 #include "events.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
52 #include "extents-impl.h"
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
53 #include "file-coding.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
54 #include "frame-impl.h"
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
55 #include "gc.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 #include "glyphs.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 #include "opaque.h"
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
58 #include "lstream.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
59 #include "process.h"
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
60 #include "profile.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 #include "redisplay.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 #include "specifier.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 #include "sysfile.h"
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
64 #include "sysdep.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 #include "window.h"
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
66 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
67 #include "vdb.h"
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
68 #endif /* NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 #include "console-stream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 #ifdef DOUG_LEA_MALLOC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 #include <malloc.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 #endif
4803
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
74 #ifdef USE_VALGRIND
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
75 #include <valgrind/memcheck.h>
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
76 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 EXFUN (Fgarbage_collect, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 #if 0 /* this is _way_ too slow to be part of the standard debug options */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 #if defined(DEBUG_XEMACS) && defined(MULE)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 #define VERIFY_STRING_CHARS_INTEGRITY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 /* Define this to use malloc/free with no freelist for all datatypes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 the hope being that some debugging tools may help detect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 freed memory references */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 #ifdef USE_DEBUG_MALLOC /* Taking the above comment at face value -slb */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 #include <dmalloc.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 #define ALLOC_NO_POOLS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 #ifdef DEBUG_XEMACS
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
95 static Fixnum debug_allocation;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
96 static Fixnum debug_allocation_backtrace_length;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
99 int need_to_check_c_alloca;
887
ccc3177ef10b [xemacs-hg @ 2002-06-28 14:21:41 by michaels]
michaels
parents: 872
diff changeset
100 int need_to_signal_post_gc;
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
101 int funcall_allocation_flag;
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
102 Bytecount __temp_alloca_size__;
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
103 Bytecount funcall_alloca_count;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
104
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
105 /* All the built-in lisp object types are enumerated in `enum lrecord_type'.
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
106 Additional ones may be defined by a module (none yet). We leave some
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
107 room in `lrecord_implementations_table' for such new lisp object types. */
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
108 struct lrecord_implementation *lrecord_implementations_table[(int)lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT];
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
109 int lrecord_type_count = lrecord_type_last_built_in_type;
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
110
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
111 /* This is just for use by the printer, to allow things to print uniquely.
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
112 We have a separate UID space for each object. (Important because the
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
113 UID is only 20 bits in old-GC, and 22 in NEW_GC.) */
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
114 int lrecord_uid_counter[countof (lrecord_implementations_table)];
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
115
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
116 #ifndef USE_KKCC
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
117 /* Object marker functions are in the lrecord_implementation structure.
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
118 But copying them to a parallel array is much more cache-friendly.
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
119 This hack speeds up (garbage-collect) by about 5%. */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
120 Lisp_Object (*lrecord_markers[countof (lrecord_implementations_table)]) (Lisp_Object);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
121 #endif /* not USE_KKCC */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
122
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
123 struct gcpro *gcprolist;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
124
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
125 /* Non-zero means we're in the process of doing the dump */
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
126 int purify_flag;
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
127
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
128 /* Non-zero means we're pdumping out or in */
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
129 #ifdef PDUMP
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
130 int in_pdump;
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
131 #endif
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
132
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
133 #ifdef ERROR_CHECK_TYPES
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
134
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
135 Error_Behavior ERROR_ME, ERROR_ME_NOT, ERROR_ME_WARN, ERROR_ME_DEBUG_WARN;
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
136
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
137 #endif
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
138
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
139 #ifdef MEMORY_USAGE_STATS
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
140 Lisp_Object Qobject_actually_requested, Qobject_malloc_overhead;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
141 Lisp_Object Qother_memory_actually_requested, Qother_memory_malloc_overhead;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
142 Lisp_Object Qother_memory_dynarr_overhead, Qother_memory_gap_overhead;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
143 #endif /* MEMORY_USAGE_STATS */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
144
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
145 /* Very cheesy ways of figuring out how much memory is being used for
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
146 data. #### Need better (system-dependent) ways. */
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
147 void *minimum_address_seen;
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
148 void *maximum_address_seen;
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
149
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
150 /* Determine now whether we need to garbage collect or not, to make
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
151 Ffuncall() faster */
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
152 #define INCREMENT_CONS_COUNTER_1(size) \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
153 do \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
154 { \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
155 consing_since_gc += (size); \
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
156 total_consing += (size); \
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
157 if (profiling_active) \
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
158 profile_record_consing (size); \
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
159 recompute_need_to_garbage_collect (); \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
160 } while (0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 #define debug_allocation_backtrace() \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 if (debug_allocation_backtrace_length > 0) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 debug_short_backtrace (debug_allocation_backtrace_length); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 #ifdef DEBUG_XEMACS
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
169 #define INCREMENT_CONS_COUNTER(foosize, type) \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
170 do { \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
171 if (debug_allocation) \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
172 { \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
173 stderr_out ("allocating %s (size %ld)\n", type, \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
174 (long) foosize); \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
175 debug_allocation_backtrace (); \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
176 } \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
177 INCREMENT_CONS_COUNTER_1 (foosize); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 #define NOSEEUM_INCREMENT_CONS_COUNTER(foosize, type) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 if (debug_allocation > 1) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 { \
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
183 stderr_out ("allocating noseeum %s (size %ld)\n", type, \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
184 (long) foosize); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 debug_allocation_backtrace (); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 INCREMENT_CONS_COUNTER_1 (foosize); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 #define INCREMENT_CONS_COUNTER(size, type) INCREMENT_CONS_COUNTER_1 (size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 #define NOSEEUM_INCREMENT_CONS_COUNTER(size, type) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 INCREMENT_CONS_COUNTER_1 (size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
195 #ifdef NEW_GC
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
196 /* [[ The call to recompute_need_to_garbage_collect is moved to
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
197 free_normal_lisp_object, since DECREMENT_CONS_COUNTER is extensively called
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
198 during sweep and recomputing need_to_garbage_collect all the time
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
199 is not needed. ]] -- not accurate! */
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
200 #define DECREMENT_CONS_COUNTER(size) do { \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
201 consing_since_gc -= (size); \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
202 total_consing -= (size); \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
203 if (profiling_active) \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
204 profile_record_unconsing (size); \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
205 if (consing_since_gc < 0) \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
206 consing_since_gc = 0; \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
207 } while (0)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
208 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 #define DECREMENT_CONS_COUNTER(size) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 consing_since_gc -= (size); \
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
211 total_consing -= (size); \
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
212 if (profiling_active) \
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
213 profile_record_unconsing (size); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 if (consing_since_gc < 0) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 consing_since_gc = 0; \
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
216 recompute_need_to_garbage_collect (); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 } while (0)
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
218 #endif /*not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
220 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 c_readonly (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 return POINTER_TYPE_P (XTYPE (obj)) && C_READONLY (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
226 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 lisp_readonly (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 return POINTER_TYPE_P (XTYPE (obj)) && LISP_READONLY (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 /* Maximum amount of C stack to save when a GC happens. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 #ifndef MAX_SAVE_STACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 #define MAX_SAVE_STACK 0 /* 16000 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 /* Non-zero means ignore malloc warnings. Set during initialization. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 int ignore_malloc_warnings;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
245 #ifndef NEW_GC
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
246 void *breathing_space;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 release_breathing_space (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 if (breathing_space)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 void *tmp = breathing_space;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 breathing_space = 0;
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4969
diff changeset
255 xfree (tmp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
258 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
260 static void
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
261 set_alloc_mins_and_maxes (void *val, Bytecount size)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
262 {
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
263 if (!val)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
264 return;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
265 if ((char *) val + size > (char *) maximum_address_seen)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
266 maximum_address_seen = (char *) val + size;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
267 if (!minimum_address_seen)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
268 minimum_address_seen =
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
269 #if SIZEOF_VOID_P == 8
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
270 (void *) 0xFFFFFFFFFFFFFFFF;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
271 #else
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
272 (void *) 0xFFFFFFFF;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
273 #endif
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
274 if ((char *) val < (char *) minimum_address_seen)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
275 minimum_address_seen = (char *) val;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
276 }
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
277
1315
70921960b980 [xemacs-hg @ 2003-02-20 08:19:28 by ben]
ben
parents: 1292
diff changeset
278 #ifdef ERROR_CHECK_MALLOC
3176
1c2a4e4e81d9 [xemacs-hg @ 2005-12-25 11:21:45 by aidan]
aidan
parents: 3170
diff changeset
279 static int in_malloc;
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1318
diff changeset
280 extern int regex_malloc_disallowed;
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
281
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
282 #define MALLOC_BEGIN() \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
283 do \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
284 { \
3176
1c2a4e4e81d9 [xemacs-hg @ 2005-12-25 11:21:45 by aidan]
aidan
parents: 3170
diff changeset
285 assert (!in_malloc); \
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
286 assert (!regex_malloc_disallowed); \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
287 in_malloc = 1; \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
288 } \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
289 while (0)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
290
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
291 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
292 #define FREE_OR_REALLOC_BEGIN(block) \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
293 do \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
294 { \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
295 /* Unbelievably, calling free() on 0xDEADBEEF doesn't cause an \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
296 error until much later on for many system mallocs, such as \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
297 the one that comes with Solaris 2.3. FMH!! */ \
4938
299dce99bdad (for main branch) when freeing check against DEADBEEF_CONSTANT since that's what we use elsewhere
Ben Wing <ben@xemacs.org>
parents: 4934
diff changeset
298 assert (block != (void *) DEADBEEF_CONSTANT); \
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
299 MALLOC_BEGIN (); \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
300 } \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
301 while (0)
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
302 #else /* not NEW_GC */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
303 #define FREE_OR_REALLOC_BEGIN(block) \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
304 do \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
305 { \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
306 /* Unbelievably, calling free() on 0xDEADBEEF doesn't cause an \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
307 error until much later on for many system mallocs, such as \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
308 the one that comes with Solaris 2.3. FMH!! */ \
4938
299dce99bdad (for main branch) when freeing check against DEADBEEF_CONSTANT since that's what we use elsewhere
Ben Wing <ben@xemacs.org>
parents: 4934
diff changeset
309 assert (block != (void *) DEADBEEF_CONSTANT); \
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
310 /* You cannot free something within dumped space, because there is \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
311 no longer any sort of malloc structure associated with the block. \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
312 If you are tripping this, you may need to conditionalize on \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
313 DUMPEDP. */ \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
314 assert (!DUMPEDP (block)); \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
315 MALLOC_BEGIN (); \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
316 } \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
317 while (0)
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
318 #endif /* not NEW_GC */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
319
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
320 #define MALLOC_END() \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
321 do \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
322 { \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
323 in_malloc = 0; \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
324 } \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
325 while (0)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
326
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
327 #else /* ERROR_CHECK_MALLOC */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
328
2658
a48989ca6db3 [xemacs-hg @ 2005-03-13 09:20:58 by crestani]
crestani
parents: 2650
diff changeset
329 #define MALLOC_BEGIN()
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
330 #define FREE_OR_REALLOC_BEGIN(block)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
331 #define MALLOC_END()
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
332
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
333 #endif /* ERROR_CHECK_MALLOC */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
334
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
335 static void
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
336 malloc_after (void *val, Bytecount size)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
337 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
338 if (!val && size != 0)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
339 memory_full ();
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
340 set_alloc_mins_and_maxes (val, size);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
341 }
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
342
3305
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
343 /* malloc calls this if it finds we are near exhausting storage */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
344 void
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
345 malloc_warning (const char *str)
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
346 {
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
347 if (ignore_malloc_warnings)
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
348 return;
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
349
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
350 /* Remove the malloc lock here, because warn_when_safe may allocate
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
351 again. It is safe to remove the malloc lock here, because malloc
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
352 is already finished (malloc_warning is called via
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
353 after_morecore_hook -> check_memory_limits -> save_warn_fun ->
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
354 malloc_warning). */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
355 MALLOC_END ();
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
356
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
357 warn_when_safe
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
358 (Qmemory, Qemergency,
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
359 "%s\n"
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
360 "Killing some buffers may delay running out of memory.\n"
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
361 "However, certainly by the time you receive the 95%% warning,\n"
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
362 "you should clean up, kill this Emacs, and start a new one.",
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
363 str);
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
364 }
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
365
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
366 /* Called if malloc returns zero */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
367 DOESNT_RETURN
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
368 memory_full (void)
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
369 {
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
370 /* Force a GC next time eval is called.
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
371 It's better to loop garbage-collecting (we might reclaim enough
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
372 to win) than to loop beeping and barfing "Memory exhausted"
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
373 */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
374 consing_since_gc = gc_cons_threshold + 1;
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
375 recompute_need_to_garbage_collect ();
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
376 #ifdef NEW_GC
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
377 /* Put mc-alloc into memory shortage mode. This may keep XEmacs
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
378 alive until the garbage collector can free enough memory to get
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
379 us out of the memory exhaustion. If already in memory shortage
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
380 mode, we are in a loop and hopelessly lost. */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
381 if (memory_shortage)
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
382 {
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
383 fprintf (stderr, "Memory full, cannot recover.\n");
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
384 ABORT ();
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
385 }
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
386 fprintf (stderr,
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
387 "Memory full, try to recover.\n"
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
388 "You should clean up, kill this Emacs, and start a new one.\n");
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
389 memory_shortage++;
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
390 #else /* not NEW_GC */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
391 release_breathing_space ();
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
392 #endif /* not NEW_GC */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
393
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
394 /* Flush some histories which might conceivably contain garbalogical
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
395 inhibitors. */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
396 if (!NILP (Fboundp (Qvalues)))
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
397 Fset (Qvalues, Qnil);
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
398 Vcommand_history = Qnil;
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
399
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
400 out_of_memory ("Memory exhausted", Qunbound);
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
401 }
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
402
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
403 /* like malloc, calloc, realloc, free but:
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
404
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
405 -- check for no memory left
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
406 -- set internal mins and maxes
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
407 -- with error-checking on, check for reentrancy, invalid freeing, etc.
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
408 */
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
409
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 #undef xmalloc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 void *
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
412 xmalloc (Bytecount size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
414 void *val;
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
415 MALLOC_BEGIN ();
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
416 val = malloc (size);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
417 MALLOC_END ();
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
418 malloc_after (val, size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 #undef xcalloc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 static void *
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
424 xcalloc (Elemcount nelem, Bytecount elsize)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
426 void *val;
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
427 MALLOC_BEGIN ();
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
428 val= calloc (nelem, elsize);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
429 MALLOC_END ();
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
430 malloc_after (val, nelem * elsize);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 void *
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
435 xmalloc_and_zero (Bytecount size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 return xcalloc (size, sizeof (char));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 #undef xrealloc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 void *
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
442 xrealloc (void *block, Bytecount size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
444 FREE_OR_REALLOC_BEGIN (block);
551
e9a3f8b4de53 [xemacs-hg @ 2001-05-21 05:26:06 by martinb]
martinb
parents: 460
diff changeset
445 block = realloc (block, size);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
446 MALLOC_END ();
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
447 malloc_after (block, size);
551
e9a3f8b4de53 [xemacs-hg @ 2001-05-21 05:26:06 by martinb]
martinb
parents: 460
diff changeset
448 return block;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 xfree_1 (void *block)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 #ifdef ERROR_CHECK_MALLOC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 assert (block);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 #endif /* ERROR_CHECK_MALLOC */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
457 FREE_OR_REALLOC_BEGIN (block);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 free (block);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
459 MALLOC_END ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
462 void
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
463 deadbeef_memory (void *ptr, Bytecount size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
465 UINT_32_BIT *ptr4 = (UINT_32_BIT *) ptr;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
466 Bytecount beefs = size >> 2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 /* In practice, size will always be a multiple of four. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 while (beefs--)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
470 (*ptr4++) = 0xDEADBEEF; /* -559038737 base 10 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 #undef xstrdup
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 char *
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
475 xstrdup (const char *str)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 int len = strlen (str) + 1; /* for stupid terminating 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 void *val = xmalloc (len);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
479
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 if (val == 0) return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 return (char *) memcpy (val, str, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 #ifdef NEED_STRDUP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 char *
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
486 strdup (const char *s)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 return xstrdup (s);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 #endif /* NEED_STRDUP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
493 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 static void *
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
495 allocate_lisp_storage (Bytecount size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
497 void *val = xmalloc (size);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
498 /* We don't increment the cons counter anymore. Calling functions do
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
499 that now because we have two different kinds of cons counters -- one
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
500 for normal objects, and one for no-see-um conses (and possibly others
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
501 similar) where the conses are used totally internally, never escape,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
502 and are created and then freed and shouldn't logically increment the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
503 cons counting. #### (Or perhaps, we should decrement it when an object
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
504 get freed?) */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
505
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
506 /* But we do now (as of 3-27-02) go and zero out the memory. This is a
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
507 good thing, as it will guarantee we won't get any intermittent bugs
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
508 coming from an uninitiated field. The speed loss is unnoticeable,
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
509 esp. as the objects are not large -- large stuff like buffer text and
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
510 redisplay structures are allocated separately. */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
511 memset (val, 0, size);
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
512
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
513 if (need_to_check_c_alloca)
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
514 xemacs_c_alloca (0);
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
515
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
516 return val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
518 #endif /* not NEW_GC */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
519
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
520 #if defined (NEW_GC) && defined (ALLOC_TYPE_STATS)
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
521 static struct
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
522 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
523 int instances_in_use;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
524 int bytes_in_use;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
525 int bytes_in_use_including_overhead;
3461
fd2936bbfc5f [xemacs-hg @ 2006-06-19 18:10:17 by james]
james
parents: 3355
diff changeset
526 } lrecord_stats [countof (lrecord_implementations_table)];
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
527
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
528 void
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
529 init_lrecord_stats (void)
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
530 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
531 xzero (lrecord_stats);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
532 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
533
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
534 void
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
535 inc_lrecord_stats (Bytecount size, const struct lrecord_header *h)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
536 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
537 int type_index = h->type;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
538 if (!size)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
539 size = detagged_lisp_object_size (h);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
540
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
541 lrecord_stats[type_index].instances_in_use++;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
542 lrecord_stats[type_index].bytes_in_use += size;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
543 lrecord_stats[type_index].bytes_in_use_including_overhead
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
544 #ifdef MEMORY_USAGE_STATS
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
545 += mc_alloced_storage_size (size, 0);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
546 #else /* not MEMORY_USAGE_STATS */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
547 += size;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
548 #endif /* not MEMORY_USAGE_STATS */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
549 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
550
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
551 void
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
552 dec_lrecord_stats (Bytecount size_including_overhead,
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
553 const struct lrecord_header *h)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
554 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
555 int type_index = h->type;
2775
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani]
crestani
parents: 2720
diff changeset
556 int size = detagged_lisp_object_size (h);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
557
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
558 lrecord_stats[type_index].instances_in_use--;
2775
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani]
crestani
parents: 2720
diff changeset
559 lrecord_stats[type_index].bytes_in_use -= size;
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
560 lrecord_stats[type_index].bytes_in_use_including_overhead
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
561 -= size_including_overhead;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
562
2775
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani]
crestani
parents: 2720
diff changeset
563 DECREMENT_CONS_COUNTER (size);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
564 }
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
565
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
566 int
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
567 lrecord_stats_heap_size (void)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
568 {
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
569 int i;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
570 int size = 0;
3461
fd2936bbfc5f [xemacs-hg @ 2006-06-19 18:10:17 by james]
james
parents: 3355
diff changeset
571 for (i = 0; i < countof (lrecord_implementations_table); i++)
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
572 size += lrecord_stats[i].bytes_in_use;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
573 return size;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
574 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
575 #endif /* NEW_GC && ALLOC_TYPE_STATS */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
576
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
577 #define assert_proper_sizing(size) \
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
578 type_checking_assert \
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
579 (implementation->static_size == 0 ? \
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
580 implementation->size_in_bytes_method != NULL : \
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
581 implementation->size_in_bytes_method == NULL && \
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
582 implementation->static_size == size)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
583
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
584 #ifndef NEW_GC
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
585 /* lcrecords are chained together through their "next" field.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
586 After doing the mark phase, GC will walk this linked list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
587 and free any lcrecord which hasn't been marked. */
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
588 static struct old_lcrecord_header *all_lcrecords;
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
589 #endif /* not NEW_GC */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
590
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
591 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
592 /* The basic lrecord allocation functions. See lrecord.h for details. */
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
593 static Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
594 alloc_sized_lrecord_1 (Bytecount size,
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
595 const struct lrecord_implementation *implementation,
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
596 int noseeum)
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
597 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
598 struct lrecord_header *lheader;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
599
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
600 assert_proper_sizing (size);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
601
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
602 lheader = (struct lrecord_header *) mc_alloc (size);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
603 gc_checking_assert (LRECORD_FREE_P (lheader));
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
604 set_lheader_implementation (lheader, implementation);
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
605 #ifdef ALLOC_TYPE_STATS
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
606 inc_lrecord_stats (size, lheader);
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
607 #endif /* ALLOC_TYPE_STATS */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
608 if (implementation->finalizer)
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
609 add_finalizable_obj (wrap_pointer_1 (lheader));
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
610 if (noseeum)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
611 NOSEEUM_INCREMENT_CONS_COUNTER (size, implementation->name);
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
612 else
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
613 INCREMENT_CONS_COUNTER (size, implementation->name);
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
614 return wrap_pointer_1 (lheader);
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
615 }
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
616
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
617 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
618 alloc_sized_lrecord (Bytecount size,
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
619 const struct lrecord_implementation *implementation)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
620 {
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
621 return alloc_sized_lrecord_1 (size, implementation, 0);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
622 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
623
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
624 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
625 noseeum_alloc_sized_lrecord (Bytecount size,
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
626 const struct lrecord_implementation *
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
627 implementation)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
628 {
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
629 return alloc_sized_lrecord_1 (size, implementation, 1);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
630 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
631
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
632 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
633 alloc_lrecord (const struct lrecord_implementation *implementation)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
634 {
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
635 type_checking_assert (implementation->static_size > 0);
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
636 return alloc_sized_lrecord (implementation->static_size, implementation);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
637 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
638
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
639 Lisp_Object
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
640 noseeum_alloc_lrecord (const struct lrecord_implementation *implementation)
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
641 {
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
642 type_checking_assert (implementation->static_size > 0);
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
643 return noseeum_alloc_sized_lrecord (implementation->static_size, implementation);
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
644 }
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
645
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
646 Lisp_Object
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
647 alloc_sized_lrecord_array (Bytecount size, int elemcount,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
648 const struct lrecord_implementation *implementation)
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
649 {
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
650 struct lrecord_header *lheader;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
651 Rawbyte *start, *stop;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
652
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
653 assert_proper_sizing (size);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
654
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
655 lheader = (struct lrecord_header *) mc_alloc_array (size, elemcount);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
656 gc_checking_assert (LRECORD_FREE_P (lheader));
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
657
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
658 for (start = (Rawbyte *) lheader,
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
659 /* #### FIXME: why is this -1 present? */
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
660 stop = ((Rawbyte *) lheader) + (size * elemcount -1);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
661 start < stop; start += size)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
662 {
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
663 struct lrecord_header *lh = (struct lrecord_header *) start;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
664 set_lheader_implementation (lh, implementation);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
665 #ifdef ALLOC_TYPE_STATS
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
666 inc_lrecord_stats (size, lh);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
667 #endif /* not ALLOC_TYPE_STATS */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
668 if (implementation->finalizer)
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
669 add_finalizable_obj (wrap_pointer_1 (lh));
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
670 }
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
671
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
672 INCREMENT_CONS_COUNTER (size * elemcount, implementation->name);
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
673 return wrap_pointer_1 (lheader);
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
674 }
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
675
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
676 Lisp_Object
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
677 alloc_lrecord_array (int elemcount,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
678 const struct lrecord_implementation *implementation)
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
679 {
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
680 type_checking_assert (implementation->static_size > 0);
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
681 return alloc_sized_lrecord_array (implementation->static_size, elemcount,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
682 implementation);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
683 }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
684
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
685 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
687 /* The most basic of the lcrecord allocation functions. Not usually called
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
688 directly. Allocates an lrecord not managed by any lcrecord-list, of a
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
689 specified size. See lrecord.h. */
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
690
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
691 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
692 old_alloc_sized_lcrecord (Bytecount size,
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
693 const struct lrecord_implementation *implementation)
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
694 {
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
695 struct old_lcrecord_header *lcheader;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
697 assert_proper_sizing (size);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
698 type_checking_assert
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
699 (!implementation->frob_block_p
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
700 &&
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
701 !(implementation->hash == NULL && implementation->equal != NULL));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
703 lcheader = (struct old_lcrecord_header *) allocate_lisp_storage (size);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
704 set_lheader_implementation (&lcheader->lheader, implementation);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 lcheader->next = all_lcrecords;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 all_lcrecords = lcheader;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 INCREMENT_CONS_COUNTER (size, implementation->name);
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
708 return wrap_pointer_1 (lcheader);
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
709 }
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
710
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
711 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
712 old_alloc_lcrecord (const struct lrecord_implementation *implementation)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
713 {
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
714 type_checking_assert (implementation->static_size > 0);
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
715 return old_alloc_sized_lcrecord (implementation->static_size,
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
716 implementation);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 #if 0 /* Presently unused */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 /* Very, very poor man's EGC?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 * This may be slow and thrash pages all over the place.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 * Only call it if you really feel you must (and if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 * lrecord was fairly recently allocated).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 * Otherwise, just let the GC do its job -- that's what it's there for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 void
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
727 very_old_free_lcrecord (struct old_lcrecord_header *lcrecord)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 if (all_lcrecords == lcrecord)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 all_lcrecords = lcrecord->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 {
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
735 struct old_lcrecord_header *header = all_lcrecords;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 {
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
738 struct old_lcrecord_header *next = header->next;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 if (next == lcrecord)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 header->next = lrecord->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 else if (next == 0)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
745 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 header = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 if (lrecord->implementation->finalizer)
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
751 lrecord->implementation->finalizer (wrap_pointer_1 (lrecord));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 xfree (lrecord);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 #endif /* Unused */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
756 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 disksave_object_finalization_1 (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 {
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
762 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
763 mc_finalize_for_disksave ();
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
764 #else /* not NEW_GC */
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
765 struct old_lcrecord_header *header;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 for (header = all_lcrecords; header; header = header->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 {
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
769 struct lrecord_header *objh = &header->lheader;
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
770 const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (objh);
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
771 #if 0 /* possibly useful for debugging */
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5127
diff changeset
772 if (!RECORD_DUMPABLE (objh) && !objh->free)
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
773 {
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
774 stderr_out ("Disksaving a non-dumpable object: ");
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
775 debug_print (wrap_pointer_1 (header));
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
776 }
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
777 #endif
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
778 if (imp->disksave && !objh->free)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
779 (imp->disksave) (wrap_pointer_1 (header));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
781 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
784 /* Bitwise copy all parts of a Lisp object other than the header */
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
785
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
786 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
787 copy_lisp_object (Lisp_Object dst, Lisp_Object src)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
788 {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
789 const struct lrecord_implementation *imp =
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
790 XRECORD_LHEADER_IMPLEMENTATION (src);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
791 Bytecount size = lisp_object_size (src);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
792
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
793 assert (imp == XRECORD_LHEADER_IMPLEMENTATION (dst));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
794 assert (size == lisp_object_size (dst));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
795
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
796 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
797 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
798 (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
799 size - sizeof (struct lrecord_header));
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
800 #else /* not NEW_GC */
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
801 if (imp->frob_block_p)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
802 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header),
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
803 (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header),
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
804 size - sizeof (struct lrecord_header));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
805 else
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
806 memcpy ((char *) XRECORD_LHEADER (dst) +
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
807 sizeof (struct old_lcrecord_header),
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
808 (char *) XRECORD_LHEADER (src) +
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
809 sizeof (struct old_lcrecord_header),
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
810 size - sizeof (struct old_lcrecord_header));
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
811 #endif /* not NEW_GC */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
812 }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
813
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
814 /* Zero out all parts of a Lisp object other than the header, for a
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
815 variable-sized object. The size needs to be given explicitly because
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
816 at the time this is called, the contents of the object may not be
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
817 defined, or may not be set up in such a way that we can reliably
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
818 retrieve the size, since it may depend on settings inside of the object. */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
819
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
820 void
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
821 zero_sized_lisp_object (Lisp_Object obj, Bytecount size)
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
822 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
823 #ifndef NEW_GC
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
824 const struct lrecord_implementation *imp =
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
825 XRECORD_LHEADER_IMPLEMENTATION (obj);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
826 #endif /* not NEW_GC */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
827
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
828 #ifdef NEW_GC
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
829 memset ((char *) XRECORD_LHEADER (obj) + sizeof (struct lrecord_header), 0,
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
830 size - sizeof (struct lrecord_header));
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
831 #else /* not NEW_GC */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
832 if (imp->frob_block_p)
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
833 memset ((char *) XRECORD_LHEADER (obj) + sizeof (struct lrecord_header), 0,
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
834 size - sizeof (struct lrecord_header));
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
835 else
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
836 memset ((char *) XRECORD_LHEADER (obj) +
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
837 sizeof (struct old_lcrecord_header), 0,
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
838 size - sizeof (struct old_lcrecord_header));
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
839 #endif /* not NEW_GC */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
840 }
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
841
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
842 /* Zero out all parts of a Lisp object other than the header, for an object
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
843 that isn't variable-size. Objects that are variable-size need to use
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
844 zero_sized_lisp_object().
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
845 */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
846
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
847 void
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
848 zero_nonsized_lisp_object (Lisp_Object obj)
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
849 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
850 const struct lrecord_implementation *imp =
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
851 XRECORD_LHEADER_IMPLEMENTATION (obj);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
852 assert (!imp->size_in_bytes_method);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
853
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
854 zero_sized_lisp_object (obj, lisp_object_size (obj));
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
855 }
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
856
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
857 void
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
858 free_normal_lisp_object (Lisp_Object obj)
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
859 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
860 #ifndef NEW_GC
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
861 const struct lrecord_implementation *imp =
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
862 XRECORD_LHEADER_IMPLEMENTATION (obj);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
863 #endif /* not NEW_GC */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
864
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
865 #ifdef NEW_GC
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
866 /* Manual frees are not allowed with asynchronous finalization */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
867 return;
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
868 #else
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
869 assert (!imp->frob_block_p);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
870 assert (!imp->size_in_bytes_method);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
871 old_free_lcrecord (obj);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
872 #endif
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
873 }
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
874
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 /* Debugger support */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 /* Give gdb/dbx enough information to decode Lisp Objects. We make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 sure certain symbols are always defined, so gdb doesn't complain
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
881 about expressions in src/.gdbinit. See src/.gdbinit or src/.dbxrc
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
882 to see how this is used. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
884 EMACS_UINT dbg_valmask = ((1UL << VALBITS) - 1) << GCBITS;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
885 EMACS_UINT dbg_typemask = (1UL << GCTYPEBITS) - 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 #ifdef USE_UNION_TYPE
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
888 unsigned char dbg_USE_UNION_TYPE = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 #else
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
890 unsigned char dbg_USE_UNION_TYPE = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
893 unsigned char dbg_valbits = VALBITS;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
894 unsigned char dbg_gctypebits = GCTYPEBITS;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
895
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
896 /* On some systems, the above definitions will be optimized away by
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
897 the compiler or linker unless they are referenced in some function. */
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
898 long dbg_inhibit_dbg_symbol_deletion (void);
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
899 long
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
900 dbg_inhibit_dbg_symbol_deletion (void)
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
901 {
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
902 return
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
903 (dbg_valmask +
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
904 dbg_typemask +
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
905 dbg_USE_UNION_TYPE +
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
906 dbg_valbits +
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
907 dbg_gctypebits);
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
908 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 /* Macros turned into functions for ease of debugging.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 Debuggers don't know about macros! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 int dbg_eq (Lisp_Object obj1, Lisp_Object obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 dbg_eq (Lisp_Object obj1, Lisp_Object obj2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 return EQ (obj1, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
920 #ifdef NEW_GC
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
921 #define DECLARE_FIXED_TYPE_ALLOC(type, structture) struct __foo__
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
922 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 /* Fixed-size type macros */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 /* For fixed-size types that are commonly used, we malloc() large blocks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 of memory at a time and subdivide them into chunks of the correct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 size for an object of that type. This is more efficient than
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 malloc()ing each object separately because we save on malloc() time
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 and overhead due to the fewer number of malloc()ed blocks, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 also because we don't need any extra pointers within each object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 to keep them threaded together for GC purposes. For less common
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 (and frequently large-size) types, we use lcrecords, which are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 malloc()ed individually and chained together through a pointer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 in the lcrecord header. lcrecords do not need to be fixed-size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 (i.e. two objects of the same type need not have the same size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 however, the size of a particular object cannot vary dynamically).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 It is also much easier to create a new lcrecord type because no
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 additional code needs to be added to alloc.c. Finally, lcrecords
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 may be more efficient when there are only a small number of them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 The types that are stored in these large blocks (or "frob blocks")
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
944 are cons, all number types except fixnum, compiled-function, symbol,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
945 marker, extent, event, and string.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 Note that strings are special in that they are actually stored in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 two parts: a structure containing information about the string, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 the actual data associated with the string. The former structure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 (a struct Lisp_String) is a fixed-size structure and is managed the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 same way as all the other such types. This structure contains a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 pointer to the actual string data, which is stored in structures of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 type struct string_chars_block. Each string_chars_block consists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 of a pointer to a struct Lisp_String, followed by the data for that
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
955 string, followed by another pointer to a Lisp_String, followed by
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
956 the data for that string, etc. At GC time, the data in these
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
957 blocks is compacted by searching sequentially through all the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 blocks and compressing out any holes created by unmarked strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 Strings that are more than a certain size (bigger than the size of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 a string_chars_block, although something like half as big might
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 make more sense) are malloc()ed separately and not stored in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 string_chars_blocks. Furthermore, no one string stretches across
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 two string_chars_blocks.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
965 Vectors are each malloc()ed separately as lcrecords.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 In the following discussion, we use conses, but it applies equally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 well to the other fixed-size types.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 We store cons cells inside of cons_blocks, allocating a new
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 cons_block with malloc() whenever necessary. Cons cells reclaimed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 by GC are put on a free list to be reallocated before allocating
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 any new cons cells from the latest cons_block. Each cons_block is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 just under 2^n - MALLOC_OVERHEAD bytes long, since malloc (at least
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 the versions in malloc.c and gmalloc.c) really allocates in units
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 of powers of two and uses 4 bytes for its own overhead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 What GC actually does is to search through all the cons_blocks,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 from the most recently allocated to the oldest, and put all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 cons cells that are not marked (whether or not they're already
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 free) on a cons_free_list. The cons_free_list is a stack, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 so the cons cells in the oldest-allocated cons_block end up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 at the head of the stack and are the first to be reallocated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 If any cons_block is entirely free, it is freed with free()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 and its cons cells removed from the cons_free_list. Because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 the cons_free_list ends up basically in memory order, we have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 a high locality of reference (assuming a reasonable turnover
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 of allocating and freeing) and have a reasonable probability
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 of entirely freeing up cons_blocks that have been more recently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 allocated. This stage is called the "sweep stage" of GC, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 is executed after the "mark stage", which involves starting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 from all places that are known to point to in-use Lisp objects
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 (e.g. the obarray, where are all symbols are stored; the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 current catches and condition-cases; the backtrace list of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 currently executing functions; the gcpro list; etc.) and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 recursively marking all objects that are accessible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
998 At the beginning of the sweep stage, the conses in the cons blocks
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
999 are in one of three states: in use and marked, in use but not
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1000 marked, and not in use (already freed). Any conses that are marked
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1001 have been marked in the mark stage just executed, because as part
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1002 of the sweep stage we unmark any marked objects. The way we tell
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1003 whether or not a cons cell is in use is through the LRECORD_FREE_P
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1004 macro. This uses a special lrecord type `lrecord_type_free',
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1005 which is never associated with any valid object.
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1006
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1007 Conses on the free_cons_list are threaded through a pointer stored
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1008 in the conses themselves. Because the cons is still in a
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1009 cons_block and needs to remain marked as not in use for the next
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1010 time that GC happens, we need room to store both the "free"
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1011 indicator and the chaining pointer. So this pointer is stored
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1012 after the lrecord header (actually where C places a pointer after
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1013 the lrecord header; they are not necessarily contiguous). This
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1014 implies that all fixed-size types must be big enough to contain at
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1015 least one pointer. This is true for all current fixed-size types,
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1016 with the possible exception of Lisp_Floats, for which we define the
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1017 meat of the struct using a union of a pointer and a double to
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1018 ensure adequate space for the free list chain pointer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 Some types of objects need additional "finalization" done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 when an object is converted from in use to not in use;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 this is the purpose of the ADDITIONAL_FREE_type macro.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 For example, markers need to be removed from the chain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 of markers that is kept in each buffer. This is because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 markers in a buffer automatically disappear if the marker
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 is no longer referenced anywhere (the same does not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 apply to extents, however).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 WARNING: Things are in an extremely bizarre state when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 the ADDITIONAL_FREE_type macros are called, so beware!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1032 When ERROR_CHECK_GC is defined, we do things differently so as to
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1033 maximize our chances of catching places where there is insufficient
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1034 GCPROing. The thing we want to avoid is having an object that
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1035 we're using but didn't GCPRO get freed by GC and then reallocated
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1036 while we're in the process of using it -- this will result in
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1037 something seemingly unrelated getting trashed, and is extremely
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1038 difficult to track down. If the object gets freed but not
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1039 reallocated, we can usually catch this because we set most of the
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1040 bytes of a freed object to 0xDEADBEEF. (The lisp object type is set
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1041 to the invalid type `lrecord_type_free', however, and a pointer
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1042 used to chain freed objects together is stored after the lrecord
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1043 header; we play some tricks with this pointer to make it more
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 bogus, so crashes are more likely to occur right away.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 We want freed objects to stay free as long as possible,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 so instead of doing what we do above, we maintain the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 free objects in a first-in first-out queue. We also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 don't recompute the free list each GC, unlike above;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 this ensures that the queue ordering is preserved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 [This means that we are likely to have worse locality
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 of reference, and that we can never free a frob block
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 once it's allocated. (Even if we know that all cells
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 in it are free, there's no easy way to remove all those
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 cells from the free list because the objects on the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 free list are unlikely to be in memory order.)]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 Furthermore, we never take objects off the free list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 unless there's a large number (usually 1000, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 varies depending on type) of them already on the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 This way, we ensure that an object that gets freed will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 remain free for the next 1000 (or whatever) times that
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1062 an object of that type is allocated. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 #if !defined(HAVE_MMAP) || defined(DOUG_LEA_MALLOC)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 /* If we released our reserve (due to running out of memory),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 and we have a fair amount free once again,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 try to set aside another reserve in case we run out once more.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 This is called when a relocatable block is freed in ralloc.c. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 void refill_memory_reserve (void);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1072 refill_memory_reserve (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 if (breathing_space == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 breathing_space = (char *) malloc (4096 - MALLOC_OVERHEAD);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 #ifdef ALLOC_NO_POOLS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 # define TYPE_ALLOC_SIZE(type, structtype) 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 # define TYPE_ALLOC_SIZE(type, structtype) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 ((2048 - MALLOC_OVERHEAD - sizeof (struct type##_block *)) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 / sizeof (structtype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 #endif /* ALLOC_NO_POOLS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 #define DECLARE_FIXED_TYPE_ALLOC(type, structtype) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 struct type##_block \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 struct type##_block *prev; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 structtype block[TYPE_ALLOC_SIZE (type, structtype)]; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 }; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 static struct type##_block *current_##type##_block; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 static int current_##type##_block_index; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1098 static Lisp_Free *type##_free_list; \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1099 static Lisp_Free *type##_free_list_tail; \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 static void \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 init_##type##_alloc (void) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 current_##type##_block = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 current_##type##_block_index = \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 countof (current_##type##_block->block); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 type##_free_list = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 type##_free_list_tail = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 static int gc_count_num_##type##_in_use; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 static int gc_count_num_##type##_freelist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 #define ALLOCATE_FIXED_TYPE_FROM_BLOCK(type, result) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 if (current_##type##_block_index \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 == countof (current_##type##_block->block)) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 struct type##_block *AFTFB_new = (struct type##_block *) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 allocate_lisp_storage (sizeof (struct type##_block)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 AFTFB_new->prev = current_##type##_block; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 current_##type##_block = AFTFB_new; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 current_##type##_block_index = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 (result) = \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 &(current_##type##_block->block[current_##type##_block_index++]); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 /* Allocate an instance of a type that is stored in blocks.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 TYPE is the "name" of the type, STRUCTTYPE is the corresponding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 structure type. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 #ifdef ERROR_CHECK_GC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 /* Note: if you get crashes in this function, suspect incorrect calls
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 to free_cons() and friends. This happened once because the cons
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 cell was not GC-protected and was getting collected before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 free_cons() was called. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1139 #define ALLOCATE_FIXED_TYPE_1(type, structtype, result) do { \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1140 if (gc_count_num_##type##_freelist > \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1141 MINIMUM_ALLOWED_FIXED_TYPE_CELLS_##type) \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1142 { \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1143 result = (structtype *) type##_free_list; \
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1144 assert (LRECORD_FREE_P (result)); \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1145 /* Before actually using the chain pointer, we complement \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1146 all its bits; see PUT_FIXED_TYPE_ON_FREE_LIST(). */ \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1147 type##_free_list = (Lisp_Free *) \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1148 (~ (EMACS_UINT) (type##_free_list->chain)); \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1149 gc_count_num_##type##_freelist--; \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1150 } \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1151 else \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1152 ALLOCATE_FIXED_TYPE_FROM_BLOCK (type, result); \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1153 MARK_LRECORD_AS_NOT_FREE (result); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 #else /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1158 #define ALLOCATE_FIXED_TYPE_1(type, structtype, result) do { \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 if (type##_free_list) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 { \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1161 result = (structtype *) type##_free_list; \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1162 type##_free_list = type##_free_list->chain; \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 ALLOCATE_FIXED_TYPE_FROM_BLOCK (type, result); \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1166 MARK_LRECORD_AS_NOT_FREE (result); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 #endif /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1171
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 #define ALLOCATE_FIXED_TYPE(type, structtype, result) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 do \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 ALLOCATE_FIXED_TYPE_1 (type, structtype, result); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 INCREMENT_CONS_COUNTER (sizeof (structtype), #type); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 #define NOSEEUM_ALLOCATE_FIXED_TYPE(type, structtype, result) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 do \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 ALLOCATE_FIXED_TYPE_1 (type, structtype, result); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 NOSEEUM_INCREMENT_CONS_COUNTER (sizeof (structtype), #type); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1186 /* Lisp_Free is the type to represent a free list member inside a frob
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1187 block of any lisp object type. */
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1188 typedef struct Lisp_Free
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1189 {
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1190 struct lrecord_header lheader;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1191 struct Lisp_Free *chain;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1192 } Lisp_Free;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1193
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1194 #define LRECORD_FREE_P(ptr) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1195 (((struct lrecord_header *) ptr)->type == lrecord_type_free)
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1196
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1197 #define MARK_LRECORD_AS_FREE(ptr) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1198 ((void) (((struct lrecord_header *) ptr)->type = lrecord_type_free))
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1199
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1200 #ifdef ERROR_CHECK_GC
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1201 #define MARK_LRECORD_AS_NOT_FREE(ptr) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1202 ((void) (((struct lrecord_header *) ptr)->type = lrecord_type_undefined))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 #else
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1204 #define MARK_LRECORD_AS_NOT_FREE(ptr) DO_NOTHING
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 #ifdef ERROR_CHECK_GC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1209 #define PUT_FIXED_TYPE_ON_FREE_LIST(type, structtype, ptr) do { \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1210 if (type##_free_list_tail) \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1211 { \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1212 /* When we store the chain pointer, we complement all \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1213 its bits; this should significantly increase its \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1214 bogosity in case someone tries to use the value, and \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1215 should make us crash faster if someone overwrites the \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1216 pointer because when it gets un-complemented in \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1217 ALLOCATED_FIXED_TYPE(), the resulting pointer will be \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1218 extremely bogus. */ \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1219 type##_free_list_tail->chain = \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1220 (Lisp_Free *) ~ (EMACS_UINT) (ptr); \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1221 } \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1222 else \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1223 type##_free_list = (Lisp_Free *) (ptr); \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1224 type##_free_list_tail = (Lisp_Free *) (ptr); \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1225 } while (0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 #else /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1229 #define PUT_FIXED_TYPE_ON_FREE_LIST(type, structtype, ptr) do { \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1230 ((Lisp_Free *) (ptr))->chain = type##_free_list; \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1231 type##_free_list = (Lisp_Free *) (ptr); \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1232 } while (0) \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 #endif /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 /* TYPE and STRUCTTYPE are the same as in ALLOCATE_FIXED_TYPE(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 #define FREE_FIXED_TYPE(type, structtype, ptr) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 structtype *FFT_ptr = (ptr); \
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1240 gc_checking_assert (!LRECORD_FREE_P (FFT_ptr)); \
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1241 gc_checking_assert (!DUMPEDP (FFT_ptr)); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 ADDITIONAL_FREE_##type (FFT_ptr); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 deadbeef_memory (FFT_ptr, sizeof (structtype)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 PUT_FIXED_TYPE_ON_FREE_LIST (type, structtype, FFT_ptr); \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1245 MARK_LRECORD_AS_FREE (FFT_ptr); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 } while (0)
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1247 #endif /* NEW_GC */
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1248
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1249 #ifdef NEW_GC
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1250 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr) \
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1251 free_normal_lisp_object (lo)
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1252 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 /* Like FREE_FIXED_TYPE() but used when we are explicitly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 freeing a structure through free_cons(), free_marker(), etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 rather than through the normal process of sweeping.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 We attempt to undo the changes made to the allocation counters
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 as a result of this structure being allocated. This is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 completely necessary but helps keep things saner: e.g. this way,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 repeatedly allocating and freeing a cons will not result in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 the consing-since-gc counter advancing, which would cause a GC
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1261 and somewhat defeat the purpose of explicitly freeing.
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1262
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1263 We also disable this mechanism entirely when ALLOC_NO_POOLS is
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1264 set, which is used for Purify and the like. */
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1265
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1266 #ifndef ALLOC_NO_POOLS
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1267 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1268 do { FREE_FIXED_TYPE (type, structtype, ptr); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1269 DECREMENT_CONS_COUNTER (sizeof (structtype)); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1270 gc_count_num_##type##_freelist++; \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 } while (0)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1272 #else
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1273 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1274 #endif
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1275 #endif /* (not) NEW_GC */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
1276
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
1277 #ifdef NEW_GC
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1278 #define ALLOC_FROB_BLOCK_LISP_OBJECT(type, lisp_type, var, lrec_ptr)\
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1279 do { \
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1280 (var) = (lisp_type *) XPNTR (ALLOC_NORMAL_LISP_OBJECT (type)); \
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1281 } while (0)
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1282 #define NOSEEUM_ALLOC_FROB_BLOCK_LISP_OBJECT(type, lisp_type, var, \
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1283 lrec_ptr) \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1284 do { \
5120
d1247f3cc363 latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents: 5118
diff changeset
1285 (var) = (lisp_type *) XPNTR (noseeum_alloc_lrecord (lrec_ptr)); \
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1286 } while (0)
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
1287 #else /* not NEW_GC */
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1288 #define ALLOC_FROB_BLOCK_LISP_OBJECT(type, lisp_type, var, lrec_ptr) \
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1289 do \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1290 { \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1291 ALLOCATE_FIXED_TYPE (type, lisp_type, var); \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1292 set_lheader_implementation (&(var)->lheader, lrec_ptr); \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1293 } while (0)
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1294 #define NOSEEUM_ALLOC_FROB_BLOCK_LISP_OBJECT(type, lisp_type, var, \
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1295 lrec_ptr) \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1296 do \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1297 { \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1298 NOSEEUM_ALLOCATE_FIXED_TYPE (type, lisp_type, var); \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1299 set_lheader_implementation (&(var)->lheader, lrec_ptr); \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1300 } while (0)
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
1301 #endif /* not NEW_GC */
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1302
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 /* Cons allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1309 DECLARE_FIXED_TYPE_ALLOC (cons, Lisp_Cons);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 /* conses are used and freed so often that we set this really high */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 20000 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 2000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 mark_cons (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 if (NILP (XCDR (obj)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 return XCAR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 mark_object (XCAR (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 return XCDR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 static int
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
1325 cons_equal (Lisp_Object ob1, Lisp_Object ob2, int depth, int foldcase)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1327 depth++;
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
1328 while (internal_equal_0 (XCAR (ob1), XCAR (ob2), depth, foldcase))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 ob1 = XCDR (ob1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 ob2 = XCDR (ob2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 if (! CONSP (ob1) || ! CONSP (ob2))
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
1333 return internal_equal_0 (ob1, ob2, depth, foldcase);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1338 static const struct memory_description cons_description[] = {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1339 { XD_LISP_OBJECT, offsetof (Lisp_Cons, car_) },
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1340 { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr_) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1344 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("cons", cons,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1345 mark_cons, print_cons, 0, cons_equal,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1346 /*
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1347 * No `hash' method needed.
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1348 * internal_hash knows how to
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1349 * handle conses.
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1350 */
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1351 0, cons_description, Lisp_Cons);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 DEFUN ("cons", Fcons, 2, 2, 0, /*
3355
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3305
diff changeset
1354 Create a new cons cell, give it CAR and CDR as components, and return it.
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3305
diff changeset
1355
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3305
diff changeset
1356 A cons cell is a Lisp object (an area in memory) made up of two pointers
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3305
diff changeset
1357 called the CAR and the CDR. Each of these pointers can point to any other
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3305
diff changeset
1358 Lisp object. The common Lisp data type, the list, is a specially-structured
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3305
diff changeset
1359 series of cons cells.
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3305
diff changeset
1360
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3305
diff changeset
1361 The pointers are accessed from Lisp with `car' and `cdr', and mutated with
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3305
diff changeset
1362 `setcar' and `setcdr' respectively. For historical reasons, the aliases
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3305
diff changeset
1363 `rplaca' and `rplacd' (for `setcar' and `setcdr') are supported.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 (car, cdr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 Lisp_Object val;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1369 Lisp_Cons *c;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1370
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1371 ALLOC_FROB_BLOCK_LISP_OBJECT (cons, Lisp_Cons, c, &lrecord_cons);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1372 val = wrap_cons (c);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1373 XSETCAR (val, car);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1374 XSETCDR (val, cdr);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 /* This is identical to Fcons() but it used for conses that we're
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 going to free later, and is useful when trying to track down
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 "real" consing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 noseeum_cons (Lisp_Object car, Lisp_Object cdr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 Lisp_Object val;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1385 Lisp_Cons *c;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1386
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1387 NOSEEUM_ALLOC_FROB_BLOCK_LISP_OBJECT (cons, Lisp_Cons, c, &lrecord_cons);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1388 val = wrap_cons (c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 XCAR (val) = car;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 XCDR (val) = cdr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 DEFUN ("list", Flist, 0, MANY, 0, /*
4693
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
1395 Return a newly created list with specified ARGS as elements.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 Any number of arguments, even zero arguments, are allowed.
4693
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
1397
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
1398 arguments: (&rest ARGS)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 Lisp_Object val = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 Lisp_Object *argp = args + nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 while (argp > args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 val = Fcons (*--argp, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 list1 (Lisp_Object obj0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 return Fcons (obj0, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 list2 (Lisp_Object obj0, Lisp_Object obj1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 return Fcons (obj0, Fcons (obj1, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 list3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 return Fcons (obj0, Fcons (obj1, Fcons (obj2, Qnil)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 cons3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 return Fcons (obj0, Fcons (obj1, obj2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 acons (Lisp_Object key, Lisp_Object value, Lisp_Object alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 return Fcons (Fcons (key, value), alist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 list4 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, Lisp_Object obj3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Qnil))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 list5 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, Lisp_Object obj3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 Lisp_Object obj4)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Fcons (obj4, Qnil)))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 list6 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, Lisp_Object obj3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 Lisp_Object obj4, Lisp_Object obj5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Fcons (obj4, Fcons (obj5, Qnil))))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1467 /* Return a list of arbitrary length, terminated by Qunbound. */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1468
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1469 Lisp_Object
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1470 listu (Lisp_Object first, ...)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1471 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1472 Lisp_Object obj = Qnil;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1473 Lisp_Object val;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1474 va_list va;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1475
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1476 va_start (va, first);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1477 val = first;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1478 while (!UNBOUNDP (val))
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1479 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1480 obj = Fcons (val, obj);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1481 val = va_arg (va, Lisp_Object);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1482 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1483 va_end (va);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1484 return Fnreverse (obj);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1485 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1486
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1487 /* Return a list of arbitrary length, with length specified and remaining
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1488 args making up the list. */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1489
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1490 Lisp_Object
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1491 listn (int num_args, ...)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1492 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1493 int i;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1494 Lisp_Object obj = Qnil;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1495 va_list va;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1496
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1497 va_start (va, num_args);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1498 for (i = 0; i < num_args; i++)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1499 obj = Fcons (va_arg (va, Lisp_Object), obj);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1500 va_end (va);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1501 return Fnreverse (obj);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1502 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1503
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1504 /* Return a list of arbitrary length, with length specified and an array
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1505 of elements. */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
1506
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 DEFUN ("make-list", Fmake_list, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1508 Return a new list of length LENGTH, with each element being OBJECT.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1510 (length, object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 CHECK_NATNUM (length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 Lisp_Object val = Qnil;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 617
diff changeset
1516 EMACS_INT size = XINT (length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 while (size--)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1519 val = Fcons (object, val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 /* Float allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1529 /*** With enhanced number support, these are short floats */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1530
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1531 DECLARE_FIXED_TYPE_ALLOC (float, Lisp_Float);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_float 1000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 make_float (double float_value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1537 Lisp_Float *f;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1538
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1539 ALLOC_FROB_BLOCK_LISP_OBJECT (float, Lisp_Float, f, &lrecord_float);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1540
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1541 /* Avoid dump-time `uninitialized memory read' purify warnings. */
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1542 if (sizeof (struct lrecord_header) + sizeof (double) != sizeof (*f))
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1543 zero_nonsized_lisp_object (wrap_float (f));
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1544
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 float_data (f) = float_value;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1546 return wrap_float (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 /************************************************************************/
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1551 /* Enhanced number allocation */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1552 /************************************************************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1553
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1554 /*** Bignum ***/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1555 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1556 DECLARE_FIXED_TYPE_ALLOC (bignum, Lisp_Bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1557 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_bignum 250
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1558
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1559 /* WARNING: This function returns a bignum even if its argument fits into a
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1560 fixnum. See Fcanonicalize_number(). */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1561 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1562 make_bignum (long bignum_value)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1563 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1564 Lisp_Bignum *b;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1565
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1566 ALLOC_FROB_BLOCK_LISP_OBJECT (bignum, Lisp_Bignum, b, &lrecord_bignum);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1567 bignum_init (bignum_data (b));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1568 bignum_set_long (bignum_data (b), bignum_value);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1569 return wrap_bignum (b);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1570 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1571
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1572 /* WARNING: This function returns a bignum even if its argument fits into a
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1573 fixnum. See Fcanonicalize_number(). */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1574 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1575 make_bignum_bg (bignum bg)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1576 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1577 Lisp_Bignum *b;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1578
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1579 ALLOC_FROB_BLOCK_LISP_OBJECT (bignum, Lisp_Bignum, b, &lrecord_bignum);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1580 bignum_init (bignum_data (b));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1581 bignum_set (bignum_data (b), bg);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1582 return wrap_bignum (b);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1583 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1584 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1585
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1586 /*** Ratio ***/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1587 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1588 DECLARE_FIXED_TYPE_ALLOC (ratio, Lisp_Ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1589 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_ratio 250
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1590
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1591 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1592 make_ratio (long numerator, unsigned long denominator)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1593 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1594 Lisp_Ratio *r;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1595
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1596 ALLOC_FROB_BLOCK_LISP_OBJECT (ratio, Lisp_Ratio, r, &lrecord_ratio);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1597 ratio_init (ratio_data (r));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1598 ratio_set_long_ulong (ratio_data (r), numerator, denominator);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1599 ratio_canonicalize (ratio_data (r));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1600 return wrap_ratio (r);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1601 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1602
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1603 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1604 make_ratio_bg (bignum numerator, bignum denominator)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1605 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1606 Lisp_Ratio *r;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1607
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1608 ALLOC_FROB_BLOCK_LISP_OBJECT (ratio, Lisp_Ratio, r, &lrecord_ratio);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1609 ratio_init (ratio_data (r));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1610 ratio_set_bignum_bignum (ratio_data (r), numerator, denominator);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1611 ratio_canonicalize (ratio_data (r));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1612 return wrap_ratio (r);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1613 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1614
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1615 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1616 make_ratio_rt (ratio rat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1617 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1618 Lisp_Ratio *r;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1619
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1620 ALLOC_FROB_BLOCK_LISP_OBJECT (ratio, Lisp_Ratio, r, &lrecord_ratio);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1621 ratio_init (ratio_data (r));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1622 ratio_set (ratio_data (r), rat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1623 return wrap_ratio (r);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1624 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1625 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1626
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1627 /*** Bigfloat ***/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1628 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1629 DECLARE_FIXED_TYPE_ALLOC (bigfloat, Lisp_Bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1630 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_bigfloat 250
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1631
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1632 /* This function creates a bigfloat with the default precision if the
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1633 PRECISION argument is zero. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1634 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1635 make_bigfloat (double float_value, unsigned long precision)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1636 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1637 Lisp_Bigfloat *f;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1638
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1639 ALLOC_FROB_BLOCK_LISP_OBJECT (bigfloat, Lisp_Bigfloat, f, &lrecord_bigfloat);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1640 if (precision == 0UL)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1641 bigfloat_init (bigfloat_data (f));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1642 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1643 bigfloat_init_prec (bigfloat_data (f), precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1644 bigfloat_set_double (bigfloat_data (f), float_value);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1645 return wrap_bigfloat (f);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1646 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1647
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1648 /* This function creates a bigfloat with the precision of its argument */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1649 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1650 make_bigfloat_bf (bigfloat float_value)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1651 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1652 Lisp_Bigfloat *f;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1653
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1654 ALLOC_FROB_BLOCK_LISP_OBJECT (bigfloat, Lisp_Bigfloat, f, &lrecord_bigfloat);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1655 bigfloat_init_prec (bigfloat_data (f), bigfloat_get_prec (float_value));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1656 bigfloat_set (bigfloat_data (f), float_value);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1657 return wrap_bigfloat (f);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1658 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1659 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1660
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1661 /************************************************************************/
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 /* Vector allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 mark_vector (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 Lisp_Vector *ptr = XVECTOR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 int len = vector_length (ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 for (i = 0; i < len - 1; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 mark_object (ptr->contents[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 return (len > 0) ? ptr->contents[len - 1] : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1677 static Bytecount
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1678 size_vector (Lisp_Object obj)
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1679 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1680
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 454
diff changeset
1681 return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, contents,
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1682 XVECTOR (obj)->size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 static int
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
1686 vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 int len = XVECTOR_LENGTH (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 if (len != XVECTOR_LENGTH (obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 Lisp_Object *ptr1 = XVECTOR_DATA (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 Lisp_Object *ptr2 = XVECTOR_DATA (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 while (len--)
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
1696 if (!internal_equal_0 (*ptr1++, *ptr2++, depth + 1, foldcase))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1702 static Hashcode
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1703 vector_hash (Lisp_Object obj, int depth)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1704 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1705 return HASH2 (XVECTOR_LENGTH (obj),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1706 internal_array_hash (XVECTOR_DATA (obj),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1707 XVECTOR_LENGTH (obj),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1708 depth + 1));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1709 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1710
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1711 static const struct memory_description vector_description[] = {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1712 { XD_LONG, offsetof (Lisp_Vector, size) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1713 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Vector, contents), XD_INDIRECT(0, 0) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1717 DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("vector", vector,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1718 mark_vector, print_vector, 0,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1719 vector_equal,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1720 vector_hash,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1721 vector_description,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1722 size_vector, Lisp_Vector);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 /* #### should allocate `small' vectors from a frob-block */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 static Lisp_Vector *
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1725 make_vector_internal (Elemcount sizei)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1727 /* no `next' field; we use lcrecords */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1728 Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object,
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1729 contents, sizei);
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
1730 Lisp_Object obj = ALLOC_SIZED_LISP_OBJECT (sizem, vector);
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
1731 Lisp_Vector *p = XVECTOR (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 p->size = sizei;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 return p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 Lisp_Object
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1738 make_vector (Elemcount length, Lisp_Object object)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 Lisp_Vector *vecp = make_vector_internal (length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 Lisp_Object *p = vector_data (vecp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 while (length--)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1744 *p++ = object;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1746 return wrap_vector (vecp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 DEFUN ("make-vector", Fmake_vector, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1750 Return a new vector of length LENGTH, with each element being OBJECT.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 See also the function `vector'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1753 (length, object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 CONCHECK_NATNUM (length);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1756 return make_vector (XINT (length), object);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 DEFUN ("vector", Fvector, 0, MANY, 0, /*
4693
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
1760 Return a newly created vector with specified ARGS as elements.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 Any number of arguments, even zero arguments, are allowed.
4693
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
1762
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
1763 arguments: (&rest ARGS)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 Lisp_Vector *vecp = make_vector_internal (nargs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 Lisp_Object *p = vector_data (vecp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 while (nargs--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 *p++ = *args++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1773 return wrap_vector (vecp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 vector1 (Lisp_Object obj0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 return Fvector (1, &obj0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 vector2 (Lisp_Object obj0, Lisp_Object obj1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 Lisp_Object args[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 return Fvector (2, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 vector3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 Lisp_Object args[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 return Fvector (3, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 #if 0 /* currently unused */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 vector4 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 Lisp_Object obj3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 Lisp_Object args[4];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 return Fvector (4, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 vector5 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 Lisp_Object obj3, Lisp_Object obj4)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 Lisp_Object args[5];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 args[4] = obj4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 return Fvector (5, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 vector6 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 Lisp_Object args[6];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 args[4] = obj4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 args[5] = obj5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 return Fvector (6, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 vector7 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 Lisp_Object obj6)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 Lisp_Object args[7];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 args[4] = obj4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 args[5] = obj5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 args[6] = obj6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 return Fvector (7, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 vector8 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 Lisp_Object obj6, Lisp_Object obj7)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 Lisp_Object args[8];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 args[4] = obj4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 args[5] = obj5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 args[6] = obj6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 args[7] = obj7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 return Fvector (8, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 #endif /* unused */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 /* Bit Vector allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 /* #### should allocate `small' bit vectors from a frob-block */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1881 static Lisp_Bit_Vector *
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1882 make_bit_vector_internal (Elemcount sizei)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1884 /* no `next' field; we use lcrecords */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1885 Elemcount num_longs = BIT_VECTOR_LONG_STORAGE (sizei);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1886 Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector,
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1887 unsigned long,
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1888 bits, num_longs);
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
1889 Lisp_Object obj = ALLOC_SIZED_LISP_OBJECT (sizem, bit_vector);
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
1890 Lisp_Bit_Vector *p = XBIT_VECTOR (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 bit_vector_length (p) = sizei;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 return p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 Lisp_Object
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1897 make_bit_vector (Elemcount length, Lisp_Object bit)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1899 Lisp_Bit_Vector *p = make_bit_vector_internal (length);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1900 Elemcount num_longs = BIT_VECTOR_LONG_STORAGE (length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1902 CHECK_BIT (bit);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1903
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1904 if (ZEROP (bit))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 memset (p->bits, 0, num_longs * sizeof (long));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1908 Elemcount bits_in_last = length & (LONGBITS_POWER_OF_2 - 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 memset (p->bits, ~0, num_longs * sizeof (long));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 /* But we have to make sure that the unused bits in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 last long are 0, so that equal/hash is easy. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 if (bits_in_last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 p->bits[num_longs - 1] &= (1 << bits_in_last) - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1916 return wrap_bit_vector (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 Lisp_Object
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1920 make_bit_vector_from_byte_vector (unsigned char *bytevec, Elemcount length)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1922 Elemcount i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 Lisp_Bit_Vector *p = make_bit_vector_internal (length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 for (i = 0; i < length; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 set_bit_vector_bit (p, i, bytevec[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1928 return wrap_bit_vector (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 DEFUN ("make-bit-vector", Fmake_bit_vector, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1932 Return a new bit vector of length LENGTH. with each bit set to BIT.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1933 BIT must be one of the integers 0 or 1. See also the function `bit-vector'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1935 (length, bit))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 CONCHECK_NATNUM (length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1939 return make_bit_vector (XINT (length), bit);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 DEFUN ("bit-vector", Fbit_vector, 0, MANY, 0, /*
4693
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
1943 Return a newly created bit vector with specified ARGS as elements.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 Any number of arguments, even zero arguments, are allowed.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1945 Each argument must be one of the integers 0 or 1.
4693
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
1946
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
1947 arguments: (&rest ARGS)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 Lisp_Bit_Vector *p = make_bit_vector_internal (nargs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 for (i = 0; i < nargs; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 CHECK_BIT (args[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 set_bit_vector_bit (p, i, !ZEROP (args[i]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1960 return wrap_bit_vector (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 /* Compiled-function allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 DECLARE_FIXED_TYPE_ALLOC (compiled_function, Lisp_Compiled_Function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_compiled_function 1000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 make_compiled_function (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 Lisp_Compiled_Function *f;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1976 ALLOC_FROB_BLOCK_LISP_OBJECT (compiled_function, Lisp_Compiled_Function,
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
1977 f, &lrecord_compiled_function);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 f->stack_depth = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 f->specpdl_depth = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 f->flags.documentationp = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 f->flags.interactivep = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 f->flags.domainp = 0; /* I18N3 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 f->instructions = Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 f->constants = Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 f->arglist = Qnil;
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
1987 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
1988 f->arguments = Qnil;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
1989 #else /* not NEW_GC */
1739
9ddedfc70c4a [xemacs-hg @ 2003-10-10 18:04:23 by james]
james
parents: 1737
diff changeset
1990 f->args = NULL;
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
1991 #endif /* not NEW_GC */
1739
9ddedfc70c4a [xemacs-hg @ 2003-10-10 18:04:23 by james]
james
parents: 1737
diff changeset
1992 f->max_args = f->min_args = f->args_in_array = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 f->doc_and_interactive = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 f->annotated = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 #endif
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1997 return wrap_compiled_function (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 DEFUN ("make-byte-code", Fmake_byte_code, 4, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 Return a new compiled-function object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 Note that, unlike all other emacs-lisp functions, calling this with five
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 arguments is NOT the same as calling it with six arguments, the last of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 which is nil. If the INTERACTIVE arg is specified as nil, then that means
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 that this function was defined with `(interactive)'. If the arg is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 specified, then that means the function is not interactive.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 This is terrible behavior which is retained for compatibility with old
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 `.elc' files which expect these semantics.
4693
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
2009
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
2010 arguments: (ARGLIST INSTRUCTIONS CONSTANTS STACK-DEPTH &optional DOC-STRING INTERACTIVE)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 /* In a non-insane world this function would have this arglist...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 (arglist instructions constants stack_depth &optional doc_string interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 Lisp_Object fun = make_compiled_function ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 Lisp_Object arglist = args[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 Lisp_Object instructions = args[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 Lisp_Object constants = args[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 Lisp_Object stack_depth = args[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 Lisp_Object doc_string = (nargs > 4) ? args[4] : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 Lisp_Object interactive = (nargs > 5) ? args[5] : Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 if (nargs < 4 || nargs > 6)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 return Fsignal (Qwrong_number_of_arguments,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 list2 (intern ("make-byte-code"), make_int (nargs)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 /* Check for valid formal parameter list now, to allow us to use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 SPECBIND_FAST_UNSAFE() later in funcall_compiled_function(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 {
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2034 EXTERNAL_LIST_LOOP_2 (symbol, arglist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 CHECK_SYMBOL (symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 if (EQ (symbol, Qt) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 EQ (symbol, Qnil) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 SYMBOL_IS_KEYWORD (symbol))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 551
diff changeset
2040 invalid_constant_2
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 ("Invalid constant symbol in formal parameter list",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 symbol, arglist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 f->arglist = arglist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 /* `instructions' is a string or a cons (string . int) for a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 lazy-loaded function. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 if (CONSP (instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 CHECK_STRING (XCAR (instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 CHECK_INT (XCDR (instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 CHECK_STRING (instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 f->instructions = instructions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 if (!NILP (constants))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 CHECK_VECTOR (constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 f->constants = constants;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 CHECK_NATNUM (stack_depth);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2065 f->stack_depth = (unsigned short) XINT (stack_depth);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
4923
8ee3c10d1ed5 remove old no-longer-useful kludgy compiled-fun annotations hack
Ben Wing <ben@xemacs.org>
parents: 4921
diff changeset
2068 f->annotated = Vload_file_name_internal;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 /* doc_string may be nil, string, int, or a cons (string . int).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 interactive may be list or string (or unbound). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 f->doc_and_interactive = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 if ((f->flags.domainp = !NILP (Vfile_domain)) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 f->doc_and_interactive = Vfile_domain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 if ((f->flags.interactivep = !UNBOUNDP (interactive)) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 f->doc_and_interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 = (UNBOUNDP (f->doc_and_interactive) ? interactive :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 Fcons (interactive, f->doc_and_interactive));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 if ((f->flags.documentationp = !NILP (doc_string)) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 f->doc_and_interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 = (UNBOUNDP (f->doc_and_interactive) ? doc_string :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 Fcons (doc_string, f->doc_and_interactive));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 if (UNBOUNDP (f->doc_and_interactive))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 f->doc_and_interactive = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 return fun;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 /* Symbol allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2101 DECLARE_FIXED_TYPE_ALLOC (symbol, Lisp_Symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_symbol 1000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104 DEFUN ("make-symbol", Fmake_symbol, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 Return a newly allocated uninterned symbol whose name is NAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 Its value and function definition are void, and its property list is nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 (name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2110 Lisp_Symbol *p;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 CHECK_STRING (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2114 ALLOC_FROB_BLOCK_LISP_OBJECT (symbol, Lisp_Symbol, p, &lrecord_symbol);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2115 p->name = name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 p->plist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 p->value = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 p->function = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 symbol_next (p) = 0;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2120 return wrap_symbol (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 /* Extent allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 DECLARE_FIXED_TYPE_ALLOC (extent, struct extent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_extent 1000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 struct extent *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 allocate_extent (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 struct extent *e;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2136 ALLOC_FROB_BLOCK_LISP_OBJECT (extent, struct extent, e, &lrecord_extent);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 extent_object (e) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 set_extent_start (e, -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 set_extent_end (e, -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 e->plist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 xzero (e->flags);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 extent_face (e) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 e->flags.end_open = 1; /* default is for endpoints to behave like markers */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 e->flags.detachable = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 return e;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 /* Event allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2156 DECLARE_FIXED_TYPE_ALLOC (event, Lisp_Event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_event 1000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 allocate_event (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2162 Lisp_Event *e;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2163
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2164 ALLOC_FROB_BLOCK_LISP_OBJECT (event, Lisp_Event, e, &lrecord_event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2166 return wrap_event (e);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2169 #ifdef EVENT_DATA_AS_OBJECTS
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2170 DECLARE_FIXED_TYPE_ALLOC (key_data, Lisp_Key_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2171 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_key_data 1000
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2172
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2173 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2174 make_key_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2175 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2176 Lisp_Key_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2177
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2178 ALLOC_FROB_BLOCK_LISP_OBJECT (key_data, Lisp_Key_Data, d,
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
2179 &lrecord_key_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2180 zero_nonsized_lisp_object (wrap_key_data (d));
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2181 d->keysym = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2182
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2183 return wrap_key_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2184 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2185
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2186 DECLARE_FIXED_TYPE_ALLOC (button_data, Lisp_Button_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2187 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_button_data 1000
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2188
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2189 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2190 make_button_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2191 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2192 Lisp_Button_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2193
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2194 ALLOC_FROB_BLOCK_LISP_OBJECT (button_data, Lisp_Button_Data, d,
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2195 &lrecord_button_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2196 zero_nonsized_lisp_object (wrap_button_data (d));
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2197 return wrap_button_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2198 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2199
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2200 DECLARE_FIXED_TYPE_ALLOC (motion_data, Lisp_Motion_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2201 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_motion_data 1000
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2202
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2203 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2204 make_motion_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2205 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2206 Lisp_Motion_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2207
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2208 ALLOC_FROB_BLOCK_LISP_OBJECT (motion_data, Lisp_Motion_Data, d,
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2209 &lrecord_motion_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2210 zero_nonsized_lisp_object (wrap_motion_data (d));
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2211
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2212 return wrap_motion_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2213 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2214
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2215 DECLARE_FIXED_TYPE_ALLOC (process_data, Lisp_Process_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2216 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_process_data 1000
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2217
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2218 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2219 make_process_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2220 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2221 Lisp_Process_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2222
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2223 ALLOC_FROB_BLOCK_LISP_OBJECT (process_data, Lisp_Process_Data, d,
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2224 &lrecord_process_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2225 zero_nonsized_lisp_object (wrap_process_data (d));
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2226 d->process = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2227
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2228 return wrap_process_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2229 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2230
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2231 DECLARE_FIXED_TYPE_ALLOC (timeout_data, Lisp_Timeout_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2232 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_timeout_data 1000
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2233
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2234 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2235 make_timeout_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2236 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2237 Lisp_Timeout_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2238
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2239 ALLOC_FROB_BLOCK_LISP_OBJECT (timeout_data, Lisp_Timeout_Data, d,
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2240 &lrecord_timeout_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2241 zero_nonsized_lisp_object (wrap_timeout_data (d));
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2242 d->function = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2243 d->object = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2244
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2245 return wrap_timeout_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2246 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2247
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2248 DECLARE_FIXED_TYPE_ALLOC (magic_data, Lisp_Magic_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2249 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_data 1000
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2250
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2251 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2252 make_magic_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2253 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2254 Lisp_Magic_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2255
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2256 ALLOC_FROB_BLOCK_LISP_OBJECT (magic_data, Lisp_Magic_Data, d,
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2257 &lrecord_magic_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2258 zero_nonsized_lisp_object (wrap_magic_data (d));
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2259
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2260 return wrap_magic_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2261 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2262
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2263 DECLARE_FIXED_TYPE_ALLOC (magic_eval_data, Lisp_Magic_Eval_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2264 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_eval_data 1000
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2265
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2266 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2267 make_magic_eval_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2268 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2269 Lisp_Magic_Eval_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2270
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2271 ALLOC_FROB_BLOCK_LISP_OBJECT (magic_eval_data, Lisp_Magic_Eval_Data, d,
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2272 &lrecord_magic_eval_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2273 zero_nonsized_lisp_object (wrap_magic_eval_data (d));
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2274 d->object = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2275
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2276 return wrap_magic_eval_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2277 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2278
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2279 DECLARE_FIXED_TYPE_ALLOC (eval_data, Lisp_Eval_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2280 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_eval_data 1000
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2281
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2282 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2283 make_eval_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2284 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2285 Lisp_Eval_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2286
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2287 ALLOC_FROB_BLOCK_LISP_OBJECT (eval_data, Lisp_Eval_Data, d,
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2288 &lrecord_eval_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2289 zero_nonsized_lisp_object (wrap_eval_data (d));
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2290 d->function = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2291 d->object = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2292
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2293 return wrap_eval_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2294 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2295
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2296 DECLARE_FIXED_TYPE_ALLOC (misc_user_data, Lisp_Misc_User_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2297 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_misc_user_data 1000
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2298
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2299 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2300 make_misc_user_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2301 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2302 Lisp_Misc_User_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2303
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2304 ALLOC_FROB_BLOCK_LISP_OBJECT (misc_user_data, Lisp_Misc_User_Data, d,
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2305 &lrecord_misc_user_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2306 zero_nonsized_lisp_object (wrap_misc_user_data (d));
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2307 d->function = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2308 d->object = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2309
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2310 return wrap_misc_user_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2311 }
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2312
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2313 #endif /* EVENT_DATA_AS_OBJECTS */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 /* Marker allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2319 DECLARE_FIXED_TYPE_ALLOC (marker, Lisp_Marker);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_marker 1000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 DEFUN ("make-marker", Fmake_marker, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 Return a new marker which does not point at any place.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2327 Lisp_Marker *p;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2328
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2329 ALLOC_FROB_BLOCK_LISP_OBJECT (marker, Lisp_Marker, p, &lrecord_marker);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 p->buffer = 0;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2331 p->membpos = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 marker_next (p) = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 marker_prev (p) = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 p->insertion_type = 0;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2335 return wrap_marker (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 noseeum_make_marker (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2341 Lisp_Marker *p;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2342
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2343 NOSEEUM_ALLOC_FROB_BLOCK_LISP_OBJECT (marker, Lisp_Marker, p,
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
2344 &lrecord_marker);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 p->buffer = 0;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2346 p->membpos = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 marker_next (p) = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 marker_prev (p) = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 p->insertion_type = 0;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2350 return wrap_marker (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 /* String allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 /* The data for "short" strings generally resides inside of structs of type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 string_chars_block. The Lisp_String structure is allocated just like any
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2360 other frob-block lrecord, and these are freelisted when they get garbage
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2361 collected. The data for short strings get compacted, but the data for
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2362 large strings do not.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 Previously Lisp_String structures were relocated, but this caused a lot
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 of bus-errors because the C code didn't include enough GCPRO's for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366 strings (since EVERY REFERENCE to a short string needed to be GCPRO'd so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 that the reference would get relocated).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 This new method makes things somewhat bigger, but it is MUCH safer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2371 DECLARE_FIXED_TYPE_ALLOC (string, Lisp_String);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 /* strings are used and freed quite often */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 10000 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 1000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 mark_string (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2379 if (CONSP (XSTRING_PLIST (obj)) && EXTENT_INFOP (XCAR (XSTRING_PLIST (obj))))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2380 flush_cached_extent_info (XCAR (XSTRING_PLIST (obj)));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2381 return XSTRING_PLIST (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 static int
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
2385 string_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth),
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
2386 int foldcase)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 Bytecount len;
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
2389 if (foldcase)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
2390 return !lisp_strcasecmp_i18n (obj1, obj2);
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
2391 else
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
2392 return (((len = XSTRING_LENGTH (obj1)) == XSTRING_LENGTH (obj2)) &&
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
2393 !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2), len));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2396 static const struct memory_description string_description[] = {
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2397 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2398 { XD_LISP_OBJECT, offsetof (Lisp_String, data_object) },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2399 #else /* not NEW_GC */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2400 { XD_BYTECOUNT, offsetof (Lisp_String, size_) },
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2401 { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data_), XD_INDIRECT(0, 1) },
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2402 #endif /* not NEW_GC */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2403 { XD_LISP_OBJECT, offsetof (Lisp_String, plist) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2407 /* We store the string's extent info as the first element of the string's
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2408 property list; and the string's MODIFF as the first or second element
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2409 of the string's property list (depending on whether the extent info
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2410 is present), but only if the string has been modified. This is ugly
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2411 but it reduces the memory allocated for the string in the vast
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2412 majority of cases, where the string is never modified and has no
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2413 extent info.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2414
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2415 #### This means you can't use an int as a key in a string's plist. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2416
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2417 static Lisp_Object *
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2418 string_plist_ptr (Lisp_Object string)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2419 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2420 Lisp_Object *ptr = &XSTRING_PLIST (string);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2421
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2422 if (CONSP (*ptr) && EXTENT_INFOP (XCAR (*ptr)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2423 ptr = &XCDR (*ptr);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2424 if (CONSP (*ptr) && INTP (XCAR (*ptr)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2425 ptr = &XCDR (*ptr);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2426 return ptr;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2427 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2428
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2429 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2430 string_getprop (Lisp_Object string, Lisp_Object property)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2431 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2432 return external_plist_get (string_plist_ptr (string), property, 0, ERROR_ME);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2433 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2434
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2435 static int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2436 string_putprop (Lisp_Object string, Lisp_Object property, Lisp_Object value)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2437 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2438 external_plist_put (string_plist_ptr (string), property, value, 0, ERROR_ME);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2439 return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2440 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2441
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2442 static int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2443 string_remprop (Lisp_Object string, Lisp_Object property)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2444 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2445 return external_remprop (string_plist_ptr (string), property, 0, ERROR_ME);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2446 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2447
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2448 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2449 string_plist (Lisp_Object string)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2450 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2451 return *string_plist_ptr (string);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2452 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2453
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
2454 #ifndef NEW_GC
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2455 /* No `finalize', or `hash' methods.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2456 internal_hash() already knows how to hash strings and finalization
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2457 is done with the ADDITIONAL_FREE_string macro, which is the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2458 standard way to do finalization when using
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2459 SWEEP_FIXED_TYPE_BLOCK(). */
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
2460
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
2461 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("string", string,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
2462 mark_string, print_string,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
2463 0, string_equal, 0,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
2464 string_description,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
2465 Lisp_String);
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
2466 #endif /* not NEW_GC */
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
2467
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2468 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2469 #define STRING_FULLSIZE(size) \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2470 ALIGN_SIZE (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_String_Direct_Data, Lisp_Object, data, (size) + 1), sizeof (Lisp_Object *));
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2471 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 /* String blocks contain this many useful bytes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 #define STRING_CHARS_BLOCK_SIZE \
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2474 ((Bytecount) (8192 - MALLOC_OVERHEAD - \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2475 ((2 * sizeof (struct string_chars_block *)) \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2476 + sizeof (EMACS_INT))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 /* Block header for small strings. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 struct string_chars_block
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 EMACS_INT pos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 struct string_chars_block *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 struct string_chars_block *prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 /* Contents of string_chars_block->string_chars are interleaved
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 string_chars structures (see below) and the actual string data */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 unsigned char string_chars[STRING_CHARS_BLOCK_SIZE];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 static struct string_chars_block *first_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 static struct string_chars_block *current_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 /* If SIZE is the length of a string, this returns how many bytes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 * the string occupies in string_chars_block->string_chars
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 * (including alignment padding).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 */
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2495 #define STRING_FULLSIZE(size) \
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2496 ALIGN_FOR_TYPE (((size) + 1 + sizeof (Lisp_String *)), Lisp_String *)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 #define BIG_STRING_FULLSIZE_P(fullsize) ((fullsize) >= STRING_CHARS_BLOCK_SIZE)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 #define BIG_STRING_SIZE_P(size) (BIG_STRING_FULLSIZE_P (STRING_FULLSIZE(size)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
2501 #define STRING_CHARS_FREE_P(ptr) ((ptr)->string == NULL)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
2502 #define MARK_STRING_CHARS_AS_FREE(ptr) ((void) ((ptr)->string = NULL))
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2503 #endif /* not NEW_GC */
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
2504
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
2505 #ifdef NEW_GC
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
2506 DEFINE_DUMPABLE_LISP_OBJECT ("string", string, mark_string, print_string,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
2507 0, string_equal, 0,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
2508 string_description, Lisp_String);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2509
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2510
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2511 static const struct memory_description string_direct_data_description[] = {
3514
8b1d806afbb3 [xemacs-hg @ 2006-07-18 15:01:27 by crestani]
crestani
parents: 3461
diff changeset
2512 { XD_BYTECOUNT, offsetof (Lisp_String_Direct_Data, size) },
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2513 { XD_END }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2514 };
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2515
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2516 static Bytecount
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2517 size_string_direct_data (Lisp_Object obj)
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2518 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2519 return STRING_FULLSIZE (XSTRING_DIRECT_DATA (obj)->size);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2520 }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2521
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2522
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2523 DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT ("string-direct-data",
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2524 string_direct_data,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2525 0,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2526 string_direct_data_description,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2527 size_string_direct_data,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2528 Lisp_String_Direct_Data);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2529
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2530
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2531 static const struct memory_description string_indirect_data_description[] = {
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2532 { XD_BYTECOUNT, offsetof (Lisp_String_Indirect_Data, size) },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2533 { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String_Indirect_Data, data),
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2534 XD_INDIRECT(0, 1) },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2535 { XD_END }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2536 };
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2537
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2538 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("string-indirect-data",
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2539 string_indirect_data,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2540 0,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2541 string_indirect_data_description,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2542 Lisp_String_Indirect_Data);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2543 #endif /* NEW_GC */
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
2544
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2545 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 struct string_chars
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2548 Lisp_String *string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 unsigned char chars[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 struct unused_string_chars
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2554 Lisp_String *string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 EMACS_INT fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559 init_string_chars_alloc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561 first_string_chars_block = xnew (struct string_chars_block);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562 first_string_chars_block->prev = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 first_string_chars_block->next = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 first_string_chars_block->pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 current_string_chars_block = first_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2567
1550
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2568 static Ibyte *
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2569 allocate_big_string_chars (Bytecount length)
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2570 {
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2571 Ibyte *p = xnew_array (Ibyte, length);
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2572 INCREMENT_CONS_COUNTER (length, "string chars");
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2573 return p;
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2574 }
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2575
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2576 static struct string_chars *
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2577 allocate_string_chars_struct (Lisp_Object string_it_goes_with,
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2578 Bytecount fullsize)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580 struct string_chars *s_chars;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2581
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2582 if (fullsize <=
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2583 (countof (current_string_chars_block->string_chars)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2584 - current_string_chars_block->pos))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 /* This string can fit in the current string chars block */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587 s_chars = (struct string_chars *)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2588 (current_string_chars_block->string_chars
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 + current_string_chars_block->pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2590 current_string_chars_block->pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2592 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2593 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2594 /* Make a new current string chars block */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2595 struct string_chars_block *new_scb = xnew (struct string_chars_block);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2597 current_string_chars_block->next = new_scb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598 new_scb->prev = current_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2599 new_scb->next = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2600 current_string_chars_block = new_scb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2601 new_scb->pos = fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2602 s_chars = (struct string_chars *)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2603 current_string_chars_block->string_chars;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2606 s_chars->string = XSTRING (string_it_goes_with);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2607
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2608 INCREMENT_CONS_COUNTER (fullsize, "string chars");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2610 return s_chars;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611 }
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2612 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2613
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2614 #ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2615 void
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2616 sledgehammer_check_ascii_begin (Lisp_Object str)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2617 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2618 Bytecount i;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2619
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2620 for (i = 0; i < XSTRING_LENGTH (str); i++)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2621 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2622 if (!byte_ascii_p (string_byte (str, i)))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2623 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2624 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2625
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2626 assert (i == (Bytecount) XSTRING_ASCII_BEGIN (str) ||
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2627 (i > MAX_STRING_ASCII_BEGIN &&
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2628 (Bytecount) XSTRING_ASCII_BEGIN (str) ==
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2629 (Bytecount) MAX_STRING_ASCII_BEGIN));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2630 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2631 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2632
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2633 /* You do NOT want to be calling this! (And if you do, you must call
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
2634 XSET_STRING_ASCII_BEGIN() after modifying the string.) Use ALLOCA ()
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2635 instead and then call make_string() like the rest of the world. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2636
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638 make_uninit_string (Bytecount length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2640 Lisp_String *s;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2641 Bytecount fullsize = STRING_FULLSIZE (length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2643 assert (length >= 0 && fullsize > 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
2645 #ifdef NEW_GC
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2646 s = XSTRING (ALLOC_NORMAL_LISP_OBJECT (string));
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
2647 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 /* Allocate the string header */
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2649 ALLOCATE_FIXED_TYPE (string, Lisp_String, s);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2650 xzero (*s);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2651 set_lheader_implementation (&s->u.lheader, &lrecord_string);
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
2652 #endif /* not NEW_GC */
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
2653
3063
d30cd499e445 [xemacs-hg @ 2005-11-13 10:48:01 by ben]
ben
parents: 3024
diff changeset
2654 /* The above allocations set the UID field, which overlaps with the
d30cd499e445 [xemacs-hg @ 2005-11-13 10:48:01 by ben]
ben
parents: 3024
diff changeset
2655 ascii-length field, to some non-zero value. We need to zero it. */
d30cd499e445 [xemacs-hg @ 2005-11-13 10:48:01 by ben]
ben
parents: 3024
diff changeset
2656 XSET_STRING_ASCII_BEGIN (wrap_string (s), 0);
d30cd499e445 [xemacs-hg @ 2005-11-13 10:48:01 by ben]
ben
parents: 3024
diff changeset
2657
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2658 #ifdef NEW_GC
3304
73051095a712 [xemacs-hg @ 2006-03-26 14:33:37 by crestani]
crestani
parents: 3263
diff changeset
2659 set_lispstringp_direct (s);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2660 STRING_DATA_OBJECT (s) =
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2661 alloc_sized_lrecord (fullsize, &lrecord_string_direct_data);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2662 #else /* not NEW_GC */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2663 set_lispstringp_data (s, BIG_STRING_FULLSIZE_P (fullsize)
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
2664 ? allocate_big_string_chars (length + 1)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
2665 : allocate_string_chars_struct (wrap_string (s),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
2666 fullsize)->chars);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2667 #endif /* not NEW_GC */
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2668
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2669 set_lispstringp_length (s, length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 s->plist = Qnil;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2671 set_string_byte (wrap_string (s), length, 0);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2672
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2673 return wrap_string (s);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676 #ifdef VERIFY_STRING_CHARS_INTEGRITY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 static void verify_string_chars_integrity (void);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680 /* Resize the string S so that DELTA bytes can be inserted starting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 at POS. If DELTA < 0, it means deletion starting at POS. If
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 POS < 0, resize the string but don't copy any characters. Use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 this if you're planning on completely overwriting the string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 void
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2687 resize_string (Lisp_Object s, Bytecount pos, Bytecount delta)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688 {
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2689 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2690 Bytecount newfullsize, len;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2691 #else /* not NEW_GC */
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2692 Bytecount oldfullsize, newfullsize;
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2693 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 #ifdef VERIFY_STRING_CHARS_INTEGRITY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695 verify_string_chars_integrity ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696 #endif
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
2697 #ifdef ERROR_CHECK_TEXT
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 if (pos >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2700 assert (pos <= XSTRING_LENGTH (s));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 if (delta < 0)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2702 assert (pos + (-delta) <= XSTRING_LENGTH (s));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2703 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 if (delta < 0)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2707 assert ((-delta) <= XSTRING_LENGTH (s));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 }
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
2709 #endif /* ERROR_CHECK_TEXT */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 if (delta == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2712 /* simplest case: no size change. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 return;
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2714
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2715 if (pos >= 0 && delta < 0)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2716 /* If DELTA < 0, the functions below will delete the characters
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2717 before POS. We want to delete characters *after* POS, however,
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2718 so convert this to the appropriate form. */
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2719 pos += -delta;
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2720
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2721 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2722 newfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s) + delta);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2723
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2724 len = XSTRING_LENGTH (s) + 1 - pos;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2725
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2726 if (delta < 0 && pos >= 0)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2727 memmove (XSTRING_DATA (s) + pos + delta,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2728 XSTRING_DATA (s) + pos, len);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2729
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2730 XSTRING_DATA_OBJECT (s) =
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2731 wrap_string_direct_data (mc_realloc (XPNTR (XSTRING_DATA_OBJECT (s)),
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2732 newfullsize));
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2733 if (delta > 0 && pos >= 0)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2734 memmove (XSTRING_DATA (s) + pos + delta, XSTRING_DATA (s) + pos,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2735 len);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2736
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
2737 #else /* not NEW_GC */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2738 oldfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2739 newfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s) + delta);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2740
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2741 if (BIG_STRING_FULLSIZE_P (oldfullsize))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2743 if (BIG_STRING_FULLSIZE_P (newfullsize))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2745 /* Both strings are big. We can just realloc().
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2746 But careful! If the string is shrinking, we have to
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2747 memmove() _before_ realloc(), and if growing, we have to
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2748 memmove() _after_ realloc() - otherwise the access is
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2749 illegal, and we might crash. */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2750 Bytecount len = XSTRING_LENGTH (s) + 1 - pos;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2751
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2752 if (delta < 0 && pos >= 0)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2753 memmove (XSTRING_DATA (s) + pos + delta,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2754 XSTRING_DATA (s) + pos, len);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2755 XSET_STRING_DATA
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2756 (s, (Ibyte *) xrealloc (XSTRING_DATA (s),
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2757 XSTRING_LENGTH (s) + delta + 1));
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2758 if (delta > 0 && pos >= 0)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2759 memmove (XSTRING_DATA (s) + pos + delta, XSTRING_DATA (s) + pos,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2760 len);
1550
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2761 /* Bump the cons counter.
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2762 Conservative; Martin let the increment be delta. */
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2763 INCREMENT_CONS_COUNTER (newfullsize, "string chars");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764 }
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2765 else /* String has been demoted from BIG_STRING. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2767 Ibyte *new_data =
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2768 allocate_string_chars_struct (s, newfullsize)->chars;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2769 Ibyte *old_data = XSTRING_DATA (s);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2770
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2771 if (pos >= 0)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2772 {
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2773 memcpy (new_data, old_data, pos);
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2774 memcpy (new_data + pos + delta, old_data + pos,
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2775 XSTRING_LENGTH (s) + 1 - pos);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2776 }
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2777 XSET_STRING_DATA (s, new_data);
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4969
diff changeset
2778 xfree (old_data);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2779 }
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2780 }
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2781 else /* old string is small */
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2782 {
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2783 if (oldfullsize == newfullsize)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2784 {
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2785 /* special case; size change but the necessary
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2786 allocation size won't change (up or down; code
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2787 somewhere depends on there not being any unused
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2788 allocation space, modulo any alignment
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2789 constraints). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790 if (pos >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2792 Ibyte *addroff = pos + XSTRING_DATA (s);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 memmove (addroff + delta, addroff,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795 /* +1 due to zero-termination. */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2796 XSTRING_LENGTH (s) + 1 - pos);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2801 Ibyte *old_data = XSTRING_DATA (s);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2802 Ibyte *new_data =
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2803 BIG_STRING_FULLSIZE_P (newfullsize)
1550
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2804 ? allocate_big_string_chars (XSTRING_LENGTH (s) + delta + 1)
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2805 : allocate_string_chars_struct (s, newfullsize)->chars;
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2806
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807 if (pos >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2809 memcpy (new_data, old_data, pos);
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2810 memcpy (new_data + pos + delta, old_data + pos,
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2811 XSTRING_LENGTH (s) + 1 - pos);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 }
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2813 XSET_STRING_DATA (s, new_data);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2814
4776
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2815 if (!DUMPEDP (old_data)) /* Can't free dumped data. */
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2816 {
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2817 /* We need to mark this chunk of the string_chars_block
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2818 as unused so that compact_string_chars() doesn't
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2819 freak. */
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2820 struct string_chars *old_s_chars = (struct string_chars *)
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2821 ((char *) old_data - offsetof (struct string_chars, chars));
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2822 /* Sanity check to make sure we aren't hosed by strange
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2823 alignment/padding. */
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2824 assert (old_s_chars->string == XSTRING (s));
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2825 MARK_STRING_CHARS_AS_FREE (old_s_chars);
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2826 ((struct unused_string_chars *) old_s_chars)->fullsize =
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2827 oldfullsize;
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2828 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829 }
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2830 }
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2831 #endif /* not NEW_GC */
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2832
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2833 XSET_STRING_LENGTH (s, XSTRING_LENGTH (s) + delta);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2834 /* If pos < 0, the string won't be zero-terminated.
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2835 Terminate now just to make sure. */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2836 XSTRING_DATA (s)[XSTRING_LENGTH (s)] = '\0';
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2837
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2838 if (pos >= 0)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2839 /* We also have to adjust all of the extent indices after the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2840 place we did the change. We say "pos - 1" because
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2841 adjust_extents() is exclusive of the starting position
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2842 passed to it. */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2843 adjust_extents (s, pos - 1, XSTRING_LENGTH (s), delta);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 #ifdef VERIFY_STRING_CHARS_INTEGRITY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2846 verify_string_chars_integrity ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2847 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2849
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2851
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2852 /* WARNING: If you modify an existing string, you must call
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2853 CHECK_LISP_WRITEABLE() before and bump_string_modiff() afterwards. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 void
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2855 set_string_char (Lisp_Object s, Charcount i, Ichar c)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2857 Ibyte newstr[MAX_ICHAR_LEN];
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2858 Bytecount bytoff = string_index_char_to_byte (s, i);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2859 Bytecount oldlen = itext_ichar_len (XSTRING_DATA (s) + bytoff);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2860 Bytecount newlen = set_itext_ichar (newstr, c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2862 sledgehammer_check_ascii_begin (s);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863 if (oldlen != newlen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 resize_string (s, bytoff, newlen - oldlen);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2865 /* Remember, XSTRING_DATA (s) might have changed so we can't cache it. */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2866 memcpy (XSTRING_DATA (s) + bytoff, newstr, newlen);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2867 if (oldlen != newlen)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2868 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2869 if (newlen > 1 && i <= (Charcount) XSTRING_ASCII_BEGIN (s))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2870 /* Everything starting with the new char is no longer part of
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2871 ascii_begin */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2872 XSET_STRING_ASCII_BEGIN (s, i);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2873 else if (newlen == 1 && i == (Charcount) XSTRING_ASCII_BEGIN (s))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2874 /* We've extended ascii_begin, and we have to figure out how much by */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2875 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2876 Bytecount j;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2877 for (j = (Bytecount) i + 1; j < XSTRING_LENGTH (s); j++)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2878 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2879 if (!byte_ascii_p (XSTRING_DATA (s)[j]))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2880 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2881 }
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2882 XSET_STRING_ASCII_BEGIN (s, min (j, (Bytecount) MAX_STRING_ASCII_BEGIN));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2883 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2884 }
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2885 sledgehammer_check_ascii_begin (s);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2886 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2888 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2889
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2890 DEFUN ("make-string", Fmake_string, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2891 Return a new string consisting of LENGTH copies of CHARACTER.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2892 LENGTH must be a non-negative integer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2893 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2894 (length, character))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2895 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2896 CHECK_NATNUM (length);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2897 CHECK_CHAR_COERCE_INT (character);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2898 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2899 Ibyte init_str[MAX_ICHAR_LEN];
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2900 int len = set_itext_ichar (init_str, XCHAR (character));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2901 Lisp_Object val = make_uninit_string (len * XINT (length));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2902
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2903 if (len == 1)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2904 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2905 /* Optimize the single-byte case */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2906 memset (XSTRING_DATA (val), XCHAR (character), XSTRING_LENGTH (val));
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2907 XSET_STRING_ASCII_BEGIN (val, min (MAX_STRING_ASCII_BEGIN,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2908 len * XINT (length)));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2909 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2910 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2911 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 617
diff changeset
2912 EMACS_INT i;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2913 Ibyte *ptr = XSTRING_DATA (val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2914
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2915 for (i = XINT (length); i; i--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2916 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2917 Ibyte *init_ptr = init_str;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2918 switch (len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2919 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2920 case 4: *ptr++ = *init_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2921 case 3: *ptr++ = *init_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 case 2: *ptr++ = *init_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 case 1: *ptr++ = *init_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2925 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2926 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2927 sledgehammer_check_ascii_begin (val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2928 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2929 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2930 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2931
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2932 DEFUN ("string", Fstring, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2933 Concatenate all the argument characters and make the result a string.
4693
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
2934
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
2935 arguments: (&rest ARGS)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2937 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2938 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
2939 Ibyte *storage = alloca_ibytes (nargs * MAX_ICHAR_LEN);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2940 Ibyte *p = storage;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2941
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2942 for (; nargs; nargs--, args++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2943 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944 Lisp_Object lisp_char = *args;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945 CHECK_CHAR_COERCE_INT (lisp_char);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2946 p += set_itext_ichar (p, XCHAR (lisp_char));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2947 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2948 return make_string (storage, p - storage);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2949 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2950
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2951 /* Initialize the ascii_begin member of a string to the correct value. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2952
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2953 void
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2954 init_string_ascii_begin (Lisp_Object string)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2955 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2956 #ifdef MULE
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2957 int i;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2958 Bytecount length = XSTRING_LENGTH (string);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2959 Ibyte *contents = XSTRING_DATA (string);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2960
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2961 for (i = 0; i < length; i++)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2962 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2963 if (!byte_ascii_p (contents[i]))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2964 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2965 }
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2966 XSET_STRING_ASCII_BEGIN (string, min (i, MAX_STRING_ASCII_BEGIN));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2967 #else
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2968 XSET_STRING_ASCII_BEGIN (string, min (XSTRING_LENGTH (string),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2969 MAX_STRING_ASCII_BEGIN));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2970 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2971 sledgehammer_check_ascii_begin (string);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2972 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2973
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974 /* Take some raw memory, which MUST already be in internal format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 and package it up into a Lisp string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2976 Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2977 make_string (const Ibyte *contents, Bytecount length)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2978 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 /* Make sure we find out about bad make_string's when they happen */
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
2982 #if defined (ERROR_CHECK_TEXT) && defined (MULE)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983 bytecount_to_charcount (contents, length); /* Just for the assertions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2984 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2985
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 val = make_uninit_string (length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 memcpy (XSTRING_DATA (val), contents, length);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2988 init_string_ascii_begin (val);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2989 sledgehammer_check_ascii_begin (val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2992
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 /* Take some raw memory, encoded in some external data format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 and convert it into a Lisp string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2995 Lisp_Object
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
2996 make_extstring (const Extbyte *contents, EMACS_INT length,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2997 Lisp_Object coding_system)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2999 Lisp_Object string;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3000 TO_INTERNAL_FORMAT (DATA, (contents, length),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3001 LISP_STRING, string,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3002 coding_system);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3003 return string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3005
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006 Lisp_Object
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3007 build_istring (const Ibyte *str)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3008 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3009 /* Some strlen's crash and burn if passed null. */
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
3010 return make_string (str, (str ? qxestrlen (str) : (Bytecount) 0));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3011 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3012
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3013 Lisp_Object
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3014 build_cistring (const CIbyte *str)
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3015 {
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3016 return build_istring ((const Ibyte *) str);
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3017 }
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3018
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3019 Lisp_Object
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3020 build_ascstring (const Ascbyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3021 {
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3022 ASSERT_ASCTEXT_ASCII (str);
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3023 return build_istring ((const Ibyte *) str);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3026 Lisp_Object
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3027 build_extstring (const Extbyte *str, Lisp_Object coding_system)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 /* Some strlen's crash and burn if passed null. */
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3030 return make_extstring ((const Extbyte *) str,
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
3031 (str ? dfc_external_data_len (str, coding_system) :
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
3032 0),
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3033 coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3036 /* Build a string whose content is a translatable message, and translate
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3037 the message according to the current language environment. */
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3038
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3039 Lisp_Object
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3040 build_msg_istring (const Ibyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3041 {
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3042 return build_istring (IGETTEXT (str));
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3043 }
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3044
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3045 /* Build a string whose content is a translatable message, and translate
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3046 the message according to the current language environment. */
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3047
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3048 Lisp_Object
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3049 build_msg_cistring (const CIbyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3050 {
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3051 return build_msg_istring ((const Ibyte *) str);
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3052 }
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3053
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3054 /* Build a string whose content is a translatable message, and translate
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3055 the message according to the current language environment.
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3056 String must be pure-ASCII, and when compiled with error-checking,
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3057 an abort will have if not pure-ASCII. */
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3058
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3059 Lisp_Object
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3060 build_msg_ascstring (const Ascbyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3061 {
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3062 ASSERT_ASCTEXT_ASCII (str);
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3063 return build_msg_istring ((const Ibyte *) str);
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3064 }
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3065
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3066 /* Build a string whose content is a translatable message, but don't
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3067 translate the message immediately. Perhaps do something else instead,
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3068 such as put a property on the string indicating that it needs to be
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3069 translated.
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3070
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3071 This is useful for strings that are built at dump time or init time,
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3072 rather than on-the-fly when the current language environment is set
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3073 properly. */
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3074
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3075 Lisp_Object
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3076 build_defer_istring (const Ibyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3077 {
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3078 Lisp_Object retval = build_istring ((Ibyte *) str);
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3079 /* Possibly do something to the return value */
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3080 return retval;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3081 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3082
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 Lisp_Object
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3084 build_defer_cistring (const CIbyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3085 {
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3086 return build_defer_istring ((Ibyte *) str);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3087 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3088
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3089 Lisp_Object
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3090 build_defer_ascstring (const Ascbyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3091 {
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3092 ASSERT_ASCTEXT_ASCII (str);
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3093 return build_defer_istring ((Ibyte *) str);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
3097 make_string_nocopy (const Ibyte *contents, Bytecount length)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
3099 Lisp_String *s;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 /* Make sure we find out about bad make_string_nocopy's when they happen */
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
3103 #if defined (ERROR_CHECK_TEXT) && defined (MULE)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104 bytecount_to_charcount (contents, length); /* Just for the assertions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3105 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3106
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3107 #ifdef NEW_GC
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3108 s = XSTRING (ALLOC_NORMAL_LISP_OBJECT (string));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3109 mcpro (wrap_pointer_1 (s)); /* otherwise nocopy_strings get
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3110 collected and static data is tried to
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3111 be freed. */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3112 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3113 /* Allocate the string header */
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
3114 ALLOCATE_FIXED_TYPE (string, Lisp_String, s);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3115 set_lheader_implementation (&s->u.lheader, &lrecord_string);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3116 SET_C_READONLY_RECORD_HEADER (&s->u.lheader);
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3117 #endif /* not NEW_GC */
3063
d30cd499e445 [xemacs-hg @ 2005-11-13 10:48:01 by ben]
ben
parents: 3024
diff changeset
3118 /* Don't need to XSET_STRING_ASCII_BEGIN() here because it happens in
d30cd499e445 [xemacs-hg @ 2005-11-13 10:48:01 by ben]
ben
parents: 3024
diff changeset
3119 init_string_ascii_begin(). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3120 s->plist = Qnil;
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
3121 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
3122 set_lispstringp_indirect (s);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3123 STRING_DATA_OBJECT (s) = ALLOC_NORMAL_LISP_OBJECT (string_indirect_data);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
3124 XSTRING_INDIRECT_DATA_DATA (STRING_DATA_OBJECT (s)) = (Ibyte *) contents;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
3125 XSTRING_INDIRECT_DATA_SIZE (STRING_DATA_OBJECT (s)) = length;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
3126 #else /* not NEW_GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
3127 set_lispstringp_data (s, (Ibyte *) contents);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
3128 set_lispstringp_length (s, length);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
3129 #endif /* not NEW_GC */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
3130 val = wrap_string (s);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3131 init_string_ascii_begin (val);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3132 sledgehammer_check_ascii_begin (val);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3133
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3134 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3135 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3137
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3138 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 /* lcrecord lists */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3141 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3143 /* Lcrecord lists are used to manage the allocation of particular
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3144 sorts of lcrecords, to avoid calling ALLOC_NORMAL_LISP_OBJECT() (and thus
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3145 malloc() and garbage-collection junk) as much as possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146 It is similar to the Blocktype class.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3147
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3148 See detailed comment in lcrecord.h.
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3149 */
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3150
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3151 const struct memory_description free_description[] = {
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2532
diff changeset
3152 { XD_LISP_OBJECT, offsetof (struct free_lcrecord_header, chain), 0, { 0 },
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3153 XD_FLAG_FREE_LISP_OBJECT },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3154 { XD_END }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3155 };
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3156
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
3157 DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("free", free, 0, free_description,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
3158 struct free_lcrecord_header);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3159
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3160 const struct memory_description lcrecord_list_description[] = {
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2532
diff changeset
3161 { XD_LISP_OBJECT, offsetof (struct lcrecord_list, free), 0, { 0 },
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3162 XD_FLAG_FREE_LISP_OBJECT },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3163 { XD_END }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3164 };
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 mark_lcrecord_list (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3169 struct lcrecord_list *list = XLCRECORD_LIST (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170 Lisp_Object chain = list->free;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172 while (!NILP (chain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 struct lrecord_header *lheader = XRECORD_LHEADER (chain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175 struct free_lcrecord_header *free_header =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 (struct free_lcrecord_header *) lheader;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3178 gc_checking_assert
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3179 (/* There should be no other pointers to the free list. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3180 ! MARKED_RECORD_HEADER_P (lheader)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3181 &&
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3182 /* Only lcrecords should be here. */
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3183 ! list->implementation->frob_block_p
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3184 &&
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3185 /* Only free lcrecords should be here. */
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5127
diff changeset
3186 lheader->free
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3187 &&
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3188 /* The type of the lcrecord must be right. */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3189 lheader->type == lrecord_type_free
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3190 &&
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3191 /* So must the size. */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3192 (list->implementation->static_size == 0 ||
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3193 list->implementation->static_size == list->size)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3194 );
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196 MARK_RECORD_HEADER (lheader);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 chain = free_header->chain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
3203 DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("lcrecord-list", lcrecord_list,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
3204 mark_lcrecord_list,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
3205 lcrecord_list_description,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
3206 struct lcrecord_list);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
3207
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 Lisp_Object
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3209 make_lcrecord_list (Elemcount size,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3210 const struct lrecord_implementation *implementation)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 {
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
3212 /* Don't use alloc_automanaged_lcrecord() avoid infinite recursion
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
3213 allocating this. */
5151
641d0cdd1d00 fix compilation problems identified by Robert Delius Royar
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
3214 struct lcrecord_list *p =
641d0cdd1d00 fix compilation problems identified by Robert Delius Royar
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
3215 XLCRECORD_LIST (old_alloc_lcrecord (&lrecord_lcrecord_list));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 p->implementation = implementation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 p->size = size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219 p->free = Qnil;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
3220 return wrap_lcrecord_list (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3224 alloc_managed_lcrecord (Lisp_Object lcrecord_list)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3225 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226 struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 if (!NILP (list->free))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229 Lisp_Object val = list->free;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230 struct free_lcrecord_header *free_header =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231 (struct free_lcrecord_header *) XPNTR (val);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3232 struct lrecord_header *lheader = &free_header->lcheader.lheader;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 #ifdef ERROR_CHECK_GC
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3235 /* Major overkill here. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 /* There should be no other pointers to the free list. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3237 assert (! MARKED_RECORD_HEADER_P (lheader));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 /* Only free lcrecords should be here. */
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5127
diff changeset
3239 assert (lheader->free);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3240 assert (lheader->type == lrecord_type_free);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3241 /* Only lcrecords should be here. */
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3242 assert (! (list->implementation->frob_block_p));
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3243 #if 0 /* Not used anymore, now that we set the type of the header to
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3244 lrecord_type_free. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245 /* The type of the lcrecord must be right. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3246 assert (LHEADER_IMPLEMENTATION (lheader) == list->implementation);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3247 #endif /* 0 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 /* So must the size. */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3249 assert (list->implementation->static_size == 0 ||
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3250 list->implementation->static_size == list->size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251 #endif /* ERROR_CHECK_GC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3252
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253 list->free = free_header->chain;
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5127
diff changeset
3254 lheader->free = 0;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3255 /* Put back the correct type, as we set it to lrecord_type_free. */
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3256 lheader->type = list->implementation->lrecord_type_index;
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3257 zero_sized_lisp_object (val, list->size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 else
5151
641d0cdd1d00 fix compilation problems identified by Robert Delius Royar
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
3261 return old_alloc_sized_lcrecord (list->size, list->implementation);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3262 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3263
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3264 /* "Free" a Lisp object LCRECORD by placing it on its associated free list
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3265 LCRECORD_LIST; next time alloc_managed_lcrecord() is called with the
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3266 same LCRECORD_LIST as its parameter, it will return an object from the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3267 free list, which may be this one. Be VERY VERY SURE there are no
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3268 pointers to this object hanging around anywhere where they might be
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3269 used!
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3270
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3271 The first thing this does before making any global state change is to
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3272 call the finalize method of the object, if it exists. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3273
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275 free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3276 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277 struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278 struct free_lcrecord_header *free_header =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3279 (struct free_lcrecord_header *) XPNTR (lcrecord);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3280 struct lrecord_header *lheader = &free_header->lcheader.lheader;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3281 const struct lrecord_implementation *implementation
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3282 = LHEADER_IMPLEMENTATION (lheader);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3283
4880
ae81a2c00f4f try harder to avoid crashing when debug-printing
Ben Wing <ben@xemacs.org>
parents: 4803
diff changeset
3284 /* If we try to debug-print during GC, we'll likely get a crash on the
ae81a2c00f4f try harder to avoid crashing when debug-printing
Ben Wing <ben@xemacs.org>
parents: 4803
diff changeset
3285 following assert (called from Lstream_delete(), from prin1_to_string()).
ae81a2c00f4f try harder to avoid crashing when debug-printing
Ben Wing <ben@xemacs.org>
parents: 4803
diff changeset
3286 Instead, just don't do anything. Worst comes to worst, we have a
ae81a2c00f4f try harder to avoid crashing when debug-printing
Ben Wing <ben@xemacs.org>
parents: 4803
diff changeset
3287 small memory leak -- and programs being debugged usually won't be
ae81a2c00f4f try harder to avoid crashing when debug-printing
Ben Wing <ben@xemacs.org>
parents: 4803
diff changeset
3288 super long-lived afterwards, anyway. */
ae81a2c00f4f try harder to avoid crashing when debug-printing
Ben Wing <ben@xemacs.org>
parents: 4803
diff changeset
3289 if (gc_in_progress && in_debug_print)
ae81a2c00f4f try harder to avoid crashing when debug-printing
Ben Wing <ben@xemacs.org>
parents: 4803
diff changeset
3290 return;
ae81a2c00f4f try harder to avoid crashing when debug-printing
Ben Wing <ben@xemacs.org>
parents: 4803
diff changeset
3291
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3292 /* Finalizer methods may try to free objects within them, which typically
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3293 won't be marked and thus are scheduled for demolition. Putting them
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3294 on the free list would be very bad, as we'd have xfree()d memory in
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3295 the list. Even if for some reason the objects are still live
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3296 (generally a logic error!), we still will have problems putting such
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3297 an object on the free list right now (e.g. we'd have to avoid calling
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3298 the finalizer twice, etc.). So basically, those finalizers should not
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3299 be freeing any objects if during GC. Abort now to catch those
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3300 problems. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3301 gc_checking_assert (!gc_in_progress);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3302
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3303 /* Make sure the size is correct. This will catch, for example,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3304 putting a window configuration on the wrong free list. */
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3305 gc_checking_assert (lisp_object_size (lcrecord) == list->size);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3306 /* Make sure the object isn't already freed. */
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5127
diff changeset
3307 gc_checking_assert (!lheader->free);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
3308 /* Freeing stuff in dumped memory is bad. If you trip this, you
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
3309 may need to check for this before freeing. */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
3310 gc_checking_assert (!OBJECT_DUMPED_P (lcrecord));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3311
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312 if (implementation->finalizer)
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3313 implementation->finalizer (lcrecord);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3314 /* Yes, there are two ways to indicate freeness -- the type is
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3315 lrecord_type_free or the ->free flag is set. We used to do only the
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3316 latter; now we do the former as well for KKCC purposes. Probably
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3317 safer in any case, as we will lose quicker this way than keeping
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3318 around an lrecord of apparently correct type but bogus junk in it. */
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3319 MARK_LRECORD_AS_FREE (lheader);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3320 free_header->chain = list->free;
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5127
diff changeset
3321 lheader->free = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3322 list->free = lcrecord;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3323 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3324
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3325 static Lisp_Object all_lcrecord_lists[countof (lrecord_implementations_table)];
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3326
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3327 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3328 alloc_automanaged_sized_lcrecord (Bytecount size,
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3329 const struct lrecord_implementation *imp)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3330 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3331 if (EQ (all_lcrecord_lists[imp->lrecord_type_index], Qzero))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3332 all_lcrecord_lists[imp->lrecord_type_index] =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3333 make_lcrecord_list (size, imp);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3334
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3335 return alloc_managed_lcrecord (all_lcrecord_lists[imp->lrecord_type_index]);
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3336 }
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3337
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3338 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3339 alloc_automanaged_lcrecord (const struct lrecord_implementation *imp)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3340 {
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3341 type_checking_assert (imp->static_size > 0);
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3342 return alloc_automanaged_sized_lcrecord (imp->static_size, imp);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3343 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3344
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3345 void
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
3346 old_free_lcrecord (Lisp_Object rec)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3347 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3348 int type = XRECORD_LHEADER (rec)->type;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3349
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3350 assert (!EQ (all_lcrecord_lists[type], Qzero));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3351
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3352 free_managed_lcrecord (all_lcrecord_lists[type], rec);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3353 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3354 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3355
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3357 DEFUN ("purecopy", Fpurecopy, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3358 Kept for compatibility, returns its argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3359 Old:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3360 Make a copy of OBJECT in pure storage.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3361 Recursively copies contents of vectors and cons cells.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3362 Does not copy symbols.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3363 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3364 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3365 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3366 return object;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370 /************************************************************************/
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3371 /* Staticpro, MCpro */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3372 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3373
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3374 /* We want the staticpro list relocated, but not the pointers found
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3375 therein, because they refer to locations in the global data segment, not
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3376 in the heap; we only dump heap objects. Hence we use a trivial
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3377 description, as for pointerless objects. (Note that the data segment
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3378 objects, which are global variables like Qfoo or Vbar, themselves are
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3379 pointers to heap objects. Each needs to be described to pdump as a
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3380 "root pointer"; this happens in the call to staticpro(). */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3381 static const struct memory_description staticpro_description_1[] = {
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3382 { XD_END }
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3383 };
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3384
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3385 static const struct sized_memory_description staticpro_description = {
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3386 sizeof (Lisp_Object *),
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3387 staticpro_description_1
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3388 };
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3389
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3390 static const struct memory_description staticpros_description_1[] = {
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3391 XD_DYNARR_DESC (Lisp_Object_ptr_dynarr, &staticpro_description),
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3392 { XD_END }
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3393 };
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3394
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3395 static const struct sized_memory_description staticpros_description = {
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3396 sizeof (Lisp_Object_ptr_dynarr),
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3397 staticpros_description_1
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3398 };
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3399
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3400 #ifdef DEBUG_XEMACS
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3401
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3402 /* Help debug crashes gc-marking a staticpro'ed object. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3403
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3404 Lisp_Object_ptr_dynarr *staticpros;
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3405 const_Ascbyte_ptr_dynarr *staticpro_names;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3406
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3407 /* Mark the Lisp_Object at non-heap VARADDRESS as a root object for
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3408 garbage collection, and for dumping. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3409 void
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3410 staticpro_1 (Lisp_Object *varaddress, const Ascbyte *varname)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3411 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3412 Dynarr_add (staticpros, varaddress);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3413 Dynarr_add (staticpro_names, varname);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3414 dump_add_root_lisp_object (varaddress);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3415 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3416
5016
2ade80e8c640 enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents: 4976
diff changeset
3417 const Ascbyte *staticpro_name (int count);
2ade80e8c640 enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents: 4976
diff changeset
3418
4934
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3419 /* External debugging function: Return the name of the variable at offset
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3420 COUNT. */
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3421 const Ascbyte *
4934
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3422 staticpro_name (int count)
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3423 {
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3424 return Dynarr_at (staticpro_names, count);
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3425 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3426
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3427 Lisp_Object_ptr_dynarr *staticpros_nodump;
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3428 const_Ascbyte_ptr_dynarr *staticpro_nodump_names;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3429
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3430 /* Mark the Lisp_Object at heap VARADDRESS as a root object for
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3431 garbage collection, but not for dumping. (See below.) */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3432 void
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3433 staticpro_nodump_1 (Lisp_Object *varaddress, const Ascbyte *varname)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3434 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3435 Dynarr_add (staticpros_nodump, varaddress);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3436 Dynarr_add (staticpro_nodump_names, varname);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3437 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3438
5016
2ade80e8c640 enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents: 4976
diff changeset
3439 const Ascbyte *staticpro_nodump_name (int count);
2ade80e8c640 enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents: 4976
diff changeset
3440
4934
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3441 /* External debugging function: Return the name of the variable at offset
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3442 COUNT. */
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3443 const Ascbyte *
4934
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3444 staticpro_nodump_name (int count)
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3445 {
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3446 return Dynarr_at (staticpro_nodump_names, count);
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3447 }
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3448
996
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3449 #ifdef HAVE_SHLIB
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3450 /* Stop treating the Lisp_Object at non-heap VARADDRESS as a root object
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3451 for garbage collection, but not for dumping. */
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3452 void
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3453 unstaticpro_nodump_1 (Lisp_Object *varaddress, const Ascbyte *varname)
996
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3454 {
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3455 Dynarr_delete_object (staticpros, varaddress);
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3456 Dynarr_delete_object (staticpro_names, varname);
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3457 }
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3458 #endif
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3459
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3460 #else /* not DEBUG_XEMACS */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3461
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3462 Lisp_Object_ptr_dynarr *staticpros;
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3463
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3464 /* Mark the Lisp_Object at non-heap VARADDRESS as a root object for
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3465 garbage collection, and for dumping. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3466 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3467 staticpro (Lisp_Object *varaddress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3468 {
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3469 Dynarr_add (staticpros, varaddress);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3470 dump_add_root_lisp_object (varaddress);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3471 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3472
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3473
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3474 Lisp_Object_ptr_dynarr *staticpros_nodump;
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3475
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3476 /* Mark the Lisp_Object at heap VARADDRESS as a root object for garbage
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3477 collection, but not for dumping. This is used for objects where the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3478 only sure pointer is in the heap (rather than in the global data
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3479 segment, as must be the case for pdump root pointers), but not inside of
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3480 another Lisp object (where it will be marked as a result of that Lisp
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3481 object's mark method). The call to staticpro_nodump() must occur *BOTH*
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3482 at initialization time and at "reinitialization" time (startup, after
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3483 pdump load.) (For example, this is the case with the predicate symbols
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3484 for specifier and coding system types. The pointer to this symbol is
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3485 inside of a methods structure, which is allocated on the heap. The
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3486 methods structure will be written out to the pdump data file, and may be
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3487 reloaded at a different address.)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3488
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3489 #### The necessity for reinitialization is a bug in pdump. Pdump should
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3490 automatically regenerate the staticpro()s for these symbols when it
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3491 loads the data in. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3492
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494 staticpro_nodump (Lisp_Object *varaddress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3495 {
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3496 Dynarr_add (staticpros_nodump, varaddress);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3498
996
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3499 #ifdef HAVE_SHLIB
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3500 /* Unmark the Lisp_Object at non-heap VARADDRESS as a root object for
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3501 garbage collection, but not for dumping. */
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3502 void
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3503 unstaticpro_nodump (Lisp_Object *varaddress)
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3504 {
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3505 Dynarr_delete_object (staticpros, varaddress);
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3506 }
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3507 #endif
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3508
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3509 #endif /* not DEBUG_XEMACS */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3510
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3511 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3512 static const struct memory_description mcpro_description_1[] = {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3513 { XD_END }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3514 };
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3515
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3516 static const struct sized_memory_description mcpro_description = {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3517 sizeof (Lisp_Object *),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3518 mcpro_description_1
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3519 };
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3520
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3521 static const struct memory_description mcpros_description_1[] = {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3522 XD_DYNARR_DESC (Lisp_Object_dynarr, &mcpro_description),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3523 { XD_END }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3524 };
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3525
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3526 static const struct sized_memory_description mcpros_description = {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3527 sizeof (Lisp_Object_dynarr),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3528 mcpros_description_1
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3529 };
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3530
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3531 #ifdef DEBUG_XEMACS
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3532
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3533 /* Help debug crashes gc-marking a mcpro'ed object. */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3534
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3535 Lisp_Object_dynarr *mcpros;
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3536 const_Ascbyte_ptr_dynarr *mcpro_names;
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3537
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3538 /* Mark the Lisp_Object at non-heap VARADDRESS as a root object for
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3539 garbage collection, and for dumping. */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3540 void
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3541 mcpro_1 (Lisp_Object varaddress, const Ascbyte *varname)
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3542 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3543 Dynarr_add (mcpros, varaddress);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3544 Dynarr_add (mcpro_names, varname);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3545 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3546
5046
d4f666cda5e6 some random fixups
Ben Wing <ben@xemacs.org>
parents: 5016
diff changeset
3547 const Ascbyte *mcpro_name (int count);
d4f666cda5e6 some random fixups
Ben Wing <ben@xemacs.org>
parents: 5016
diff changeset
3548
4934
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3549 /* External debugging function: Return the name of the variable at offset
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3550 COUNT. */
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3551 const Ascbyte *
4934
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3552 mcpro_name (int count)
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3553 {
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3554 return Dynarr_at (mcpro_names, count);
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3555 }
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3556
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3557 #else /* not DEBUG_XEMACS */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3558
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3559 Lisp_Object_dynarr *mcpros;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3560
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3561 /* Mark the Lisp_Object at non-heap VARADDRESS as a root object for
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3562 garbage collection, and for dumping. */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3563 void
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3564 mcpro (Lisp_Object varaddress)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3565 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3566 Dynarr_add (mcpros, varaddress);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3567 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3568
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3569 #endif /* not DEBUG_XEMACS */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3570 #endif /* NEW_GC */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3571
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3572
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3573 /************************************************************************/
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3574 /* Allocation Statistics */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3575 /************************************************************************/
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3576
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3577 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3578 static int gc_count_num_short_string_in_use;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 617
diff changeset
3579 static Bytecount gc_count_string_total_size;
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 617
diff changeset
3580 static Bytecount gc_count_short_string_total_size;
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3581 static Bytecount gc_count_long_string_storage_including_overhead;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3582
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3583 /* static int gc_count_total_records_used, gc_count_records_total_size; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3584
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3585
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3586 /* stats on objects in use */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3588 static struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3589 {
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3590 Elemcount instances_in_use;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3591 Bytecount bytes_in_use;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3592 Bytecount bytes_in_use_overhead;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3593 Elemcount instances_freed;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3594 Bytecount bytes_freed;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3595 Bytecount bytes_freed_overhead;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3596 Elemcount instances_on_free_list;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3597 Bytecount bytes_on_free_list;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3598 Bytecount bytes_on_free_list_overhead;
5158
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3599 #ifdef MEMORY_USAGE_STATS
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3600 Bytecount nonlisp_bytes_in_use;
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3601 struct generic_usage_stats stats;
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3602 #endif
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3603 } lrecord_stats [countof (lrecord_implementations_table)];
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3604
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3605 static void
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3606 clear_lrecord_stats (void)
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3607 {
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3608 xzero (lrecord_stats);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3609 gc_count_num_short_string_in_use = 0;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3610 gc_count_string_total_size = 0;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3611 gc_count_short_string_total_size = 0;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3612 gc_count_long_string_storage_including_overhead = 0;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3613 }
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3614
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3615 /* Keep track of extra statistics for strings -- length of the string
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3616 characters for short and long strings, number of short and long strings. */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3617 static void
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3618 tick_string_stats (Lisp_String *p, int from_sweep)
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3619 {
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3620 Bytecount size = p->size_;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3621 gc_count_string_total_size += size;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3622 if (!BIG_STRING_SIZE_P (size))
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3623 {
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3624 gc_count_short_string_total_size += size;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3625 gc_count_num_short_string_in_use++;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3626 }
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3627 else
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3628 gc_count_long_string_storage_including_overhead +=
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3629 malloced_storage_size (p->data_, p->size_, NULL);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3630 /* During the sweep stage, we count the total number of strings in use.
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3631 This gets those not stored in pdump storage. For pdump storage, we
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3632 need to bump the number of strings in use so as to get an accurate
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3633 count of all strings in use (pdump or not). But don't do this when
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3634 called from the sweep stage, or we will double-count. */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3635 if (!from_sweep)
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3636 gc_count_num_string_in_use++;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3637 }
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3638
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3639 /* As objects are sweeped, we record statistics about their memory usage.
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3640 Currently, all lcrecords are processed this way as well as any frob-block
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3641 objects that were saved and restored as a result of the pdump process.
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3642 (See pdump_objects_unmark().) Other frob-block objects do NOT get their
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3643 statistics noted this way -- instead, as the frob blocks are swept,
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3644 COPY_INTO_LRECORD_STATS() is called, and notes statistics about the
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3645 frob blocks. */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3646
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3647 void
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3648 tick_lrecord_stats (const struct lrecord_header *h,
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3649 enum lrecord_alloc_status status)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3650 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 617
diff changeset
3651 int type_index = h->type;
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3652 Bytecount obj = wrap_pointer_1 (h);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3653 Bytecount sz = lisp_object_size (obj);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3654 Bytecount sz_with_overhead = lisp_object_storage_size (obj, NULL);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3655 Bytecount overhead = sz_with_overhead - sz;
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3656
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3657 switch (status)
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3658 {
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3659 case ALLOC_IN_USE:
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3660 lrecord_stats[type_index].instances_in_use++;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3661 lrecord_stats[type_index].bytes_in_use += sz;
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3662 lrecord_stats[type_index].bytes_in_use_overhead += overhead;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3663 if (STRINGP (obj))
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3664 tick_string_stats (XSTRING (obj), 0);
5158
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3665 #ifdef MEMORY_USAGE_STATS
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3666 {
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3667 struct generic_usage_stats stats;
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3668 if (HAS_OBJECT_METH_P (obj, memory_usage))
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3669 {
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3670 int i;
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3671 int total_stats = OBJECT_PROPERTY (obj, num_extra_memusage_stats);
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3672 xzero (stats);
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3673 OBJECT_METH (obj, memory_usage, (obj, &stats));
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3674 for (i = 0; i < total_stats; i++)
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3675 lrecord_stats[type_index].stats.othervals[i] +=
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3676 stats.othervals[i];
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3677 }
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3678 }
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
3679 #endif
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3680 break;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3681 case ALLOC_FREE:
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3682 lrecord_stats[type_index].instances_freed++;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3683 lrecord_stats[type_index].bytes_freed += sz;
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3684 lrecord_stats[type_index].bytes_freed_overhead += overhead;
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3685 break;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3686 case ALLOC_ON_FREE_LIST:
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3687 lrecord_stats[type_index].instances_on_free_list++;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3688 lrecord_stats[type_index].bytes_on_free_list += sz;
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3689 lrecord_stats[type_index].bytes_on_free_list_overhead += overhead;
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3690 break;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3691 default:
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3692 ABORT ();
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3693 }
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3694 }
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3695
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3696 inline static void
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3697 tick_lcrecord_stats (const struct lrecord_header *h, int free_p)
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3698 {
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5127
diff changeset
3699 if (h->free)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3700 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3701 gc_checking_assert (!free_p);
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3702 tick_lrecord_stats (h, ALLOC_ON_FREE_LIST);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3703 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3704 else
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3705 tick_lrecord_stats (h, free_p ? ALLOC_FREE : ALLOC_IN_USE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3706 }
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3707
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3708 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3710
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3711 /************************************************************************/
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3712 /* Garbage Collection -- Sweep/Compact */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3713 /************************************************************************/
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3714
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3715 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3716 /* Free all unmarked records */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3717 static void
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
3718 sweep_lcrecords_1 (struct old_lcrecord_header **prev, int *used)
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
3719 {
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
3720 struct old_lcrecord_header *header;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3721 int num_used = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3722 /* int total_size = 0; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3723
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3724 /* First go through and call all the finalize methods.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3725 Then go through and free the objects. There used to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3726 be only one loop here, with the call to the finalizer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3727 occurring directly before the xfree() below. That
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3728 is marginally faster but much less safe -- if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3729 finalize method for an object needs to reference any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3730 other objects contained within it (and many do),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3731 we could easily be screwed by having already freed that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3732 other object. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3733
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3734 for (header = *prev; header; header = header->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3735 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3736 struct lrecord_header *h = &(header->lheader);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3737
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3738 GC_CHECK_LHEADER_INVARIANTS (h);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3739
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5127
diff changeset
3740 if (! MARKED_RECORD_HEADER_P (h) && !h->free)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3741 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3742 if (LHEADER_IMPLEMENTATION (h)->finalizer)
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3743 LHEADER_IMPLEMENTATION (h)->finalizer (wrap_pointer_1 (h));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3744 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3745 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3746
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3747 for (header = *prev; header; )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3748 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3749 struct lrecord_header *h = &(header->lheader);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3750 if (MARKED_RECORD_HEADER_P (h))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3751 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3752 if (! C_READONLY_RECORD_HEADER_P (h))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3753 UNMARK_RECORD_HEADER (h);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3754 num_used++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3755 /* total_size += n->implementation->size_in_bytes (h);*/
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3756 /* #### May modify header->next on a C_READONLY lcrecord */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3757 prev = &(header->next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3758 header = *prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3759 tick_lcrecord_stats (h, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3760 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3761 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3762 {
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
3763 struct old_lcrecord_header *next = header->next;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3764 *prev = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3765 tick_lcrecord_stats (h, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3766 /* used to call finalizer right here. */
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4969
diff changeset
3767 xfree (header);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3768 header = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3769 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3770 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3771 *used = num_used;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3772 /* *total = total_size; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3773 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3774
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3775 static Bytecount fixed_type_block_overhead (Bytecount size,
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3776 Bytecount per_block);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3777
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3778 /* And the Lord said: Thou shalt use the `c-backslash-region' command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3779 to make macros prettier. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3780
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3781 #define COUNT_FROB_BLOCK_USAGE(type) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3782 EMACS_INT s = 0; \
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3783 EMACS_INT s_overhead = 0; \
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3784 struct type##_block *x = current_##type##_block; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3785 while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3786 s_overhead = fixed_type_block_overhead (s, sizeof (struct type##_block)); \
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3787 DO_NOTHING
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3788
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3789 #define COPY_INTO_LRECORD_STATS(type) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3790 do { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3791 COUNT_FROB_BLOCK_USAGE (type); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3792 lrecord_stats[lrecord_type_##type].bytes_in_use += s; \
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3793 lrecord_stats[lrecord_type_##type].bytes_in_use_overhead += \
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
3794 s_overhead; \
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3795 lrecord_stats[lrecord_type_##type].instances_on_free_list += \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3796 gc_count_num_##type##_freelist; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3797 lrecord_stats[lrecord_type_##type].instances_in_use += \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3798 gc_count_num_##type##_in_use; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3799 } while (0)
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3800
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3801 #ifdef ERROR_CHECK_GC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3802
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3803 #define SWEEP_FIXED_TYPE_BLOCK_1(typename, obj_type, lheader) \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3804 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3805 struct typename##_block *SFTB_current; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3806 int SFTB_limit; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3807 int num_free = 0, num_used = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3808 \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3809 for (SFTB_current = current_##typename##_block, \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3810 SFTB_limit = current_##typename##_block_index; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3811 SFTB_current; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3812 ) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3813 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3814 int SFTB_iii; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3815 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3816 for (SFTB_iii = 0; SFTB_iii < SFTB_limit; SFTB_iii++) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3817 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3818 obj_type *SFTB_victim = &(SFTB_current->block[SFTB_iii]); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3819 \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
3820 if (LRECORD_FREE_P (SFTB_victim)) \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3821 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3822 num_free++; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3823 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3824 else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader)) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3825 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3826 num_used++; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3827 } \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3828 else if (! MARKED_RECORD_HEADER_P (&SFTB_victim->lheader)) \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3829 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3830 num_free++; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3831 FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3832 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3833 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3834 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3835 num_used++; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3836 UNMARK_##typename (SFTB_victim); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3837 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3838 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3839 SFTB_current = SFTB_current->prev; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3840 SFTB_limit = countof (current_##typename##_block->block); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3841 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3842 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3843 gc_count_num_##typename##_in_use = num_used; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3844 gc_count_num_##typename##_freelist = num_free; \
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3845 COPY_INTO_LRECORD_STATS (typename); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3846 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3847
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3848 #else /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3849
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3850 #define SWEEP_FIXED_TYPE_BLOCK_1(typename, obj_type, lheader) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3851 do { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3852 struct typename##_block *SFTB_current; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3853 struct typename##_block **SFTB_prev; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3854 int SFTB_limit; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3855 int num_free = 0, num_used = 0; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3856 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3857 typename##_free_list = 0; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3858 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3859 for (SFTB_prev = &current_##typename##_block, \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3860 SFTB_current = current_##typename##_block, \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3861 SFTB_limit = current_##typename##_block_index; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3862 SFTB_current; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3863 ) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3864 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3865 int SFTB_iii; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3866 int SFTB_empty = 1; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3867 Lisp_Free *SFTB_old_free_list = typename##_free_list; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3868 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3869 for (SFTB_iii = 0; SFTB_iii < SFTB_limit; SFTB_iii++) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3870 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3871 obj_type *SFTB_victim = &(SFTB_current->block[SFTB_iii]); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3872 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3873 if (LRECORD_FREE_P (SFTB_victim)) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3874 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3875 num_free++; \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3876 PUT_FIXED_TYPE_ON_FREE_LIST (typename, obj_type, SFTB_victim); \
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3877 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3878 else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader)) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3879 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3880 SFTB_empty = 0; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3881 num_used++; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3882 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3883 else if (! MARKED_RECORD_HEADER_P (&SFTB_victim->lheader)) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3884 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3885 num_free++; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3886 FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3887 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3888 else \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3889 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3890 SFTB_empty = 0; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3891 num_used++; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3892 UNMARK_##typename (SFTB_victim); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3893 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3894 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3895 if (!SFTB_empty) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3896 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3897 SFTB_prev = &(SFTB_current->prev); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3898 SFTB_current = SFTB_current->prev; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3899 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3900 else if (SFTB_current == current_##typename##_block \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3901 && !SFTB_current->prev) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3902 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3903 /* No real point in freeing sole allocation block */ \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3904 break; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3905 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3906 else \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3907 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3908 struct typename##_block *SFTB_victim_block = SFTB_current; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3909 if (SFTB_victim_block == current_##typename##_block) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3910 current_##typename##_block_index \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3911 = countof (current_##typename##_block->block); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3912 SFTB_current = SFTB_current->prev; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3913 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3914 *SFTB_prev = SFTB_current; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3915 xfree (SFTB_victim_block); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3916 /* Restore free list to what it was before victim was swept */ \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3917 typename##_free_list = SFTB_old_free_list; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3918 num_free -= SFTB_limit; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3919 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3920 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3921 SFTB_limit = countof (current_##typename##_block->block); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3922 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3923 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3924 gc_count_num_##typename##_in_use = num_used; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3925 gc_count_num_##typename##_freelist = num_free; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3926 COPY_INTO_LRECORD_STATS (typename); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3927 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3928
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3929 #endif /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3930
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3931 #define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type) \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3932 SWEEP_FIXED_TYPE_BLOCK_1 (typename, obj_type, lheader)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3933
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3934 #endif /* not NEW_GC */
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3935
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3936
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3937 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3938 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3939 sweep_conses (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3940 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3941 #define UNMARK_cons(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3942 #define ADDITIONAL_FREE_cons(ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3943
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3944 SWEEP_FIXED_TYPE_BLOCK (cons, Lisp_Cons);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3945 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3946 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3947
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3948 /* Explicitly free a cons cell. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3949 void
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3950 free_cons (Lisp_Object cons)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3951 {
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3952 #ifndef NEW_GC /* to avoid compiler warning */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3953 Lisp_Cons *ptr = XCONS (cons);
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3954 #endif /* not NEW_GC */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3955
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3956 #ifdef ERROR_CHECK_GC
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3957 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3958 Lisp_Cons *ptr = XCONS (cons);
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3959 #endif /* NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3960 /* If the CAR is not an int, then it will be a pointer, which will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3961 always be four-byte aligned. If this cons cell has already been
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3962 placed on the free list, however, its car will probably contain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3963 a chain pointer to the next cons on the list, which has cleverly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3964 had all its 0's and 1's inverted. This allows for a quick
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3965 check to make sure we're not freeing something already freed.
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3966
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3967 NOTE: This check may not be necessary. Freeing an object sets its
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3968 type to lrecord_type_free, which will trip up the XCONS() above -- as
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3969 well as a check in FREE_FIXED_TYPE(). */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3970 if (POINTER_TYPE_P (XTYPE (cons_car (ptr))))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3971 ASSERT_VALID_POINTER (XPNTR (cons_car (ptr)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3972 #endif /* ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3973
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3974 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, cons, Lisp_Cons, ptr);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3975 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3976
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3977 /* explicitly free a list. You **must make sure** that you have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3978 created all the cons cells that make up this list and that there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3979 are no pointers to any of these cons cells anywhere else. If there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3980 are, you will lose. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3981
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3982 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3983 free_list (Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3984 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3985 Lisp_Object rest, next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3986
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3987 for (rest = list; !NILP (rest); rest = next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3988 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3989 next = XCDR (rest);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3990 free_cons (rest);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3991 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3992 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3994 /* explicitly free an alist. You **must make sure** that you have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3995 created all the cons cells that make up this alist and that there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3996 are no pointers to any of these cons cells anywhere else. If there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3997 are, you will lose. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3999 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4000 free_alist (Lisp_Object alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4001 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4002 Lisp_Object rest, next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4003
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4004 for (rest = alist; !NILP (rest); rest = next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4005 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4006 next = XCDR (rest);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
4007 free_cons (XCAR (rest));
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
4008 free_cons (rest);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4009 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4010 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4011
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4012 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4013 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4014 sweep_compiled_functions (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4015 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4016 #define UNMARK_compiled_function(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
945
7924b28c57a4 [xemacs-hg @ 2002-08-01 08:38:32 by michaels]
michaels
parents: 943
diff changeset
4017 #define ADDITIONAL_FREE_compiled_function(ptr) \
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4969
diff changeset
4018 if (ptr->args_in_array) xfree (ptr->args)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4019
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4020 SWEEP_FIXED_TYPE_BLOCK (compiled_function, Lisp_Compiled_Function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4021 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4022
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4023 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4024 sweep_floats (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4025 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4026 #define UNMARK_float(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4027 #define ADDITIONAL_FREE_float(ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4028
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4029 SWEEP_FIXED_TYPE_BLOCK (float, Lisp_Float);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4030 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4031
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4032 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4033 static void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4034 sweep_bignums (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4035 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4036 #define UNMARK_bignum(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4037 #define ADDITIONAL_FREE_bignum(ptr) bignum_fini (ptr->data)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4038
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4039 SWEEP_FIXED_TYPE_BLOCK (bignum, Lisp_Bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4040 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4041 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4042
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4043 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4044 static void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4045 sweep_ratios (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4046 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4047 #define UNMARK_ratio(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4048 #define ADDITIONAL_FREE_ratio(ptr) ratio_fini (ptr->data)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4049
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4050 SWEEP_FIXED_TYPE_BLOCK (ratio, Lisp_Ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4051 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4052 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4053
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4054 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4055 static void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4056 sweep_bigfloats (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4057 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4058 #define UNMARK_bigfloat(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4059 #define ADDITIONAL_FREE_bigfloat(ptr) bigfloat_fini (ptr->bf)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4060
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4061 SWEEP_FIXED_TYPE_BLOCK (bigfloat, Lisp_Bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4062 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4063 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4064
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4065 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4066 sweep_symbols (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4067 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4068 #define UNMARK_symbol(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4069 #define ADDITIONAL_FREE_symbol(ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4070
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4071 SWEEP_FIXED_TYPE_BLOCK (symbol, Lisp_Symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4072 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4073
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4074 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4075 sweep_extents (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4076 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4077 #define UNMARK_extent(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4078 #define ADDITIONAL_FREE_extent(ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4079
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4080 SWEEP_FIXED_TYPE_BLOCK (extent, struct extent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4081 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4082
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4083 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4084 sweep_events (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4085 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4086 #define UNMARK_event(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4087 #define ADDITIONAL_FREE_event(ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4088
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4089 SWEEP_FIXED_TYPE_BLOCK (event, Lisp_Event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4090 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4091 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4092
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4093 #ifdef EVENT_DATA_AS_OBJECTS
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4094
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4095 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4096 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4097 sweep_key_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4098 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4099 #define UNMARK_key_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4100 #define ADDITIONAL_FREE_key_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4101
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4102 SWEEP_FIXED_TYPE_BLOCK (key_data, Lisp_Key_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4103 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4104 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4105
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4106 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4107 free_key_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4108 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4109 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, key_data, Lisp_Key_Data,
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4110 XKEY_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4111 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4112
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4113 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4114 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4115 sweep_button_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4116 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4117 #define UNMARK_button_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4118 #define ADDITIONAL_FREE_button_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4119
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4120 SWEEP_FIXED_TYPE_BLOCK (button_data, Lisp_Button_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4121 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4122 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4123
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4124 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4125 free_button_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4126 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4127 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, button_data, Lisp_Button_Data,
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4128 XBUTTON_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4129 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4130
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4131 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4132 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4133 sweep_motion_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4134 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4135 #define UNMARK_motion_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4136 #define ADDITIONAL_FREE_motion_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4137
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4138 SWEEP_FIXED_TYPE_BLOCK (motion_data, Lisp_Motion_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4139 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4140 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4141
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4142 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4143 free_motion_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4144 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4145 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, motion_data, Lisp_Motion_Data,
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4146 XMOTION_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4147 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4148
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4149 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4150 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4151 sweep_process_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4152 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4153 #define UNMARK_process_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4154 #define ADDITIONAL_FREE_process_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4155
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4156 SWEEP_FIXED_TYPE_BLOCK (process_data, Lisp_Process_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4157 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4158 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4159
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4160 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4161 free_process_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4162 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4163 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, process_data, Lisp_Process_Data,
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4164 XPROCESS_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4165 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4166
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4167 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4168 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4169 sweep_timeout_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4170 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4171 #define UNMARK_timeout_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4172 #define ADDITIONAL_FREE_timeout_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4173
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4174 SWEEP_FIXED_TYPE_BLOCK (timeout_data, Lisp_Timeout_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4175 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4176 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4177
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4178 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4179 free_timeout_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4180 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4181 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, timeout_data, Lisp_Timeout_Data,
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4182 XTIMEOUT_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4183 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4184
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4185 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4186 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4187 sweep_magic_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4188 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4189 #define UNMARK_magic_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4190 #define ADDITIONAL_FREE_magic_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4191
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4192 SWEEP_FIXED_TYPE_BLOCK (magic_data, Lisp_Magic_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4193 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4194 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4195
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4196 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4197 free_magic_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4198 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4199 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, magic_data, Lisp_Magic_Data,
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4200 XMAGIC_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4201 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4202
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4203 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4204 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4205 sweep_magic_eval_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4206 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4207 #define UNMARK_magic_eval_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4208 #define ADDITIONAL_FREE_magic_eval_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4209
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4210 SWEEP_FIXED_TYPE_BLOCK (magic_eval_data, Lisp_Magic_Eval_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4211 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4212 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4213
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4214 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4215 free_magic_eval_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4216 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4217 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, magic_eval_data, Lisp_Magic_Eval_Data,
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4218 XMAGIC_EVAL_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4219 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4220
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4221 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4222 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4223 sweep_eval_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4224 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4225 #define UNMARK_eval_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4226 #define ADDITIONAL_FREE_eval_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4227
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4228 SWEEP_FIXED_TYPE_BLOCK (eval_data, Lisp_Eval_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4229 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4230 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4231
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4232 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4233 free_eval_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4234 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4235 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, eval_data, Lisp_Eval_Data,
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4236 XEVAL_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4237 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4238
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4239 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4240 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4241 sweep_misc_user_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4242 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4243 #define UNMARK_misc_user_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4244 #define ADDITIONAL_FREE_misc_user_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4245
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4246 SWEEP_FIXED_TYPE_BLOCK (misc_user_data, Lisp_Misc_User_Data);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4247 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4248 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4249
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4250 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4251 free_misc_user_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4252 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4253 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, misc_user_data, Lisp_Misc_User_Data,
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4254 XMISC_USER_DATA (ptr));
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4255 }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4256
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4257 #endif /* EVENT_DATA_AS_OBJECTS */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4258
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4259 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4260 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4261 sweep_markers (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4262 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4263 #define UNMARK_marker(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4264 #define ADDITIONAL_FREE_marker(ptr) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4265 do { Lisp_Object tem; \
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4266 tem = wrap_marker (ptr); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4267 unchain_marker (tem); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4268 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4269
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4270 SWEEP_FIXED_TYPE_BLOCK (marker, Lisp_Marker);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4271 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4272 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4274 /* Explicitly free a marker. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4275 void
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4276 free_marker (Lisp_Object ptr)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4277 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4278 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, marker, Lisp_Marker, XMARKER (ptr));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4279 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4281
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4282 #if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4284 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4285 verify_string_chars_integrity (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4286 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4287 struct string_chars_block *sb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4289 /* Scan each existing string block sequentially, string by string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4290 for (sb = first_string_chars_block; sb; sb = sb->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4291 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4292 int pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4293 /* POS is the index of the next string in the block. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4294 while (pos < sb->pos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4295 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4296 struct string_chars *s_chars =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4297 (struct string_chars *) &(sb->string_chars[pos]);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
4298 Lisp_String *string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4299 int size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4300 int fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4301
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4302 /* If the string_chars struct is marked as free (i.e. the
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4303 STRING pointer is NULL) then this is an unused chunk of
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4304 string storage. (See below.) */
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4305
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4306 if (STRING_CHARS_FREE_P (s_chars))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4307 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4308 fullsize = ((struct unused_string_chars *) s_chars)->fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4309 pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4310 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4311 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4313 string = s_chars->string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4314 /* Must be 32-bit aligned. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4315 assert ((((int) string) & 3) == 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4316
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4317 size = string->size_;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4318 fullsize = STRING_FULLSIZE (size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4320 assert (!BIG_STRING_FULLSIZE_P (fullsize));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4321 assert (XSTRING_DATA (string) == s_chars->chars);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4322 pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4323 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4324 assert (pos == sb->pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4325 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4326 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4327
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4328 #endif /* defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4329
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4330 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4331 /* Compactify string chars, relocating the reference to each --
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4332 free any empty string_chars_block we see. */
5016
2ade80e8c640 enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents: 4976
diff changeset
4333 static void
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4334 compact_string_chars (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4335 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4336 struct string_chars_block *to_sb = first_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4337 int to_pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4338 struct string_chars_block *from_sb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4339
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4340 /* Scan each existing string block sequentially, string by string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4341 for (from_sb = first_string_chars_block; from_sb; from_sb = from_sb->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4342 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4343 int from_pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4344 /* FROM_POS is the index of the next string in the block. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4345 while (from_pos < from_sb->pos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4346 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4347 struct string_chars *from_s_chars =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4348 (struct string_chars *) &(from_sb->string_chars[from_pos]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4349 struct string_chars *to_s_chars;
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
4350 Lisp_String *string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4351 int size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4352 int fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4353
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4354 /* If the string_chars struct is marked as free (i.e. the
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4355 STRING pointer is NULL) then this is an unused chunk of
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4356 string storage. This happens under Mule when a string's
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4357 size changes in such a way that its fullsize changes.
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4358 (Strings can change size because a different-length
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4359 character can be substituted for another character.)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4360 In this case, after the bogus string pointer is the
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4361 "fullsize" of this entry, i.e. how many bytes to skip. */
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4362
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4363 if (STRING_CHARS_FREE_P (from_s_chars))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4364 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4365 fullsize = ((struct unused_string_chars *) from_s_chars)->fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4366 from_pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4367 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4368 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4370 string = from_s_chars->string;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4371 gc_checking_assert (!(LRECORD_FREE_P (string)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4372
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4373 size = string->size_;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4374 fullsize = STRING_FULLSIZE (size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4375
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4376 gc_checking_assert (! BIG_STRING_FULLSIZE_P (fullsize));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4378 /* Just skip it if it isn't marked. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
4379 if (! MARKED_RECORD_HEADER_P (&(string->u.lheader)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4380 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4381 from_pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4382 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4383 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4384
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4385 /* If it won't fit in what's left of TO_SB, close TO_SB out
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4386 and go on to the next string_chars_block. We know that TO_SB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4387 cannot advance past FROM_SB here since FROM_SB is large enough
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4388 to currently contain this string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4389 if ((to_pos + fullsize) > countof (to_sb->string_chars))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4390 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4391 to_sb->pos = to_pos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4392 to_sb = to_sb->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4393 to_pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4394 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4396 /* Compute new address of this string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4397 and update TO_POS for the space being used. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4398 to_s_chars = (struct string_chars *) &(to_sb->string_chars[to_pos]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4400 /* Copy the string_chars to the new place. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4401 if (from_s_chars != to_s_chars)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4402 memmove (to_s_chars, from_s_chars, fullsize);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4404 /* Relocate FROM_S_CHARS's reference */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
4405 set_lispstringp_data (string, &(to_s_chars->chars[0]));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4407 from_pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4408 to_pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4409 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4410 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4412 /* Set current to the last string chars block still used and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4413 free any that follow. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4414 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4415 struct string_chars_block *victim;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4417 for (victim = to_sb->next; victim; )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4418 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4419 struct string_chars_block *next = victim->next;
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4969
diff changeset
4420 xfree (victim);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4421 victim = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4422 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4424 current_string_chars_block = to_sb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4425 current_string_chars_block->pos = to_pos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4426 current_string_chars_block->next = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4427 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4428 }
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4429 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4430
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4431 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4432 #if 1 /* Hack to debug missing purecopy's */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4433 static int debug_string_purity;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4434
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4435 static void
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4436 debug_string_purity_print (Lisp_Object p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4437 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4438 Charcount i;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
4439 Charcount s = string_char_length (p);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4440 stderr_out ("\"");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4441 for (i = 0; i < s; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4442 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
4443 Ichar ch = string_ichar (p, i);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4444 if (ch < 32 || ch >= 126)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4445 stderr_out ("\\%03o", ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4446 else if (ch == '\\' || ch == '\"')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4447 stderr_out ("\\%c", ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4448 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4449 stderr_out ("%c", ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4450 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4451 stderr_out ("\"\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4452 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4453 #endif /* 1 */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4454 #endif /* not NEW_GC */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4455
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4456 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4457 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4458 sweep_strings (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4459 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4460 int debug = debug_string_purity;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4461
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4462 #define UNMARK_string(ptr) do { \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4463 Lisp_String *p = (ptr); \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4464 UNMARK_RECORD_HEADER (&(p->u.lheader)); \
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4465 tick_string_stats (p, 1); \
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4466 if (debug) \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4467 debug_string_purity_print (wrap_string (p)); \
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
4468 } while (0)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
4469 #define ADDITIONAL_FREE_string(ptr) do { \
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4470 Bytecount size = ptr->size_; \
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
4471 if (BIG_STRING_SIZE_P (size)) \
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
4472 xfree (ptr->data_); \
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
4473 } while (0)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
4474
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
4475 SWEEP_FIXED_TYPE_BLOCK_1 (string, Lisp_String, u.lheader);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4476 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4477 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4478
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4479 #ifndef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4480 void
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4481 gc_sweep_1 (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4482 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4483 /* Reset all statistics to 0. They will be incremented when
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4484 sweeping lcrecords, frob-block lrecords and dumped objects. */
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4485 clear_lrecord_stats ();
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4486
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4487 /* Free all unmarked records. Do this at the very beginning,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4488 before anything else, so that the finalize methods can safely
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4489 examine items in the objects. sweep_lcrecords_1() makes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4490 sure to call all the finalize methods *before* freeing anything,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4491 to complete the safety. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4492 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4493 int ignored;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4494 sweep_lcrecords_1 (&all_lcrecords, &ignored);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4495 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4497 compact_string_chars ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4499 /* Finalize methods below (called through the ADDITIONAL_FREE_foo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4500 macros) must be *extremely* careful to make sure they're not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4501 referencing freed objects. The only two existing finalize
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4502 methods (for strings and markers) pass muster -- the string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4503 finalizer doesn't look at anything but its own specially-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4504 created block, and the marker finalizer only looks at live
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4505 buffers (which will never be freed) and at the markers before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4506 and after it in the chain (which, by induction, will never be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4507 freed because if so, they would have already removed themselves
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4508 from the chain). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4510 /* Put all unmarked strings on free list, free'ing the string chars
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4511 of large unmarked strings */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4512 sweep_strings ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4513
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4514 /* Put all unmarked conses on free list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4515 sweep_conses ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4517 /* Free all unmarked compiled-function objects */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4518 sweep_compiled_functions ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4519
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4520 /* Put all unmarked floats on free list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4521 sweep_floats ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4522
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4523 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4524 /* Put all unmarked bignums on free list */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4525 sweep_bignums ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4526 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4527
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4528 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4529 /* Put all unmarked ratios on free list */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4530 sweep_ratios ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4531 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4532
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4533 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4534 /* Put all unmarked bigfloats on free list */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4535 sweep_bigfloats ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4536 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4537
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4538 /* Put all unmarked symbols on free list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4539 sweep_symbols ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4540
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4541 /* Put all unmarked extents on free list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4542 sweep_extents ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4544 /* Put all unmarked markers on free list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4545 Dechain each one first from the buffer into which it points. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4546 sweep_markers ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4547
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4548 sweep_events ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4549
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4550 #ifdef EVENT_DATA_AS_OBJECTS
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4551 sweep_key_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4552 sweep_button_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4553 sweep_motion_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4554 sweep_process_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4555 sweep_timeout_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4556 sweep_magic_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4557 sweep_magic_eval_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4558 sweep_eval_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4559 sweep_misc_user_data ();
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4560 #endif /* EVENT_DATA_AS_OBJECTS */
5158
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4561
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4562 #ifdef PDUMP
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4563 pdump_objects_unmark ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4564 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4565 }
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4566 #endif /* not NEW_GC */
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4567
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4568
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4569 /************************************************************************/
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4570 /* "Disksave Finalization" -- Preparing for Dumping */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4571 /************************************************************************/
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4573 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4574 disksave_object_finalization (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4575 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4576 /* It's important that certain information from the environment not get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4577 dumped with the executable (pathnames, environment variables, etc.).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4578 To make it easier to tell when this has happened with strings(1) we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4579 clear some known-to-be-garbage blocks of memory, so that leftover
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4580 results of old evaluation don't look like potential problems.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4581 But first we set some notable variables to nil and do one more GC,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4582 to turn those strings into garbage.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4583 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4584
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4585 /* Yeah, this list is pretty ad-hoc... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4586 Vprocess_environment = Qnil;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
4587 env_initted = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4588 Vexec_directory = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4589 Vdata_directory = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4590 Vsite_directory = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4591 Vdoc_directory = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4592 Vexec_path = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4593 Vload_path = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4594 /* Vdump_load_path = Qnil; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4595 /* Release hash tables for locate_file */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4596 Flocate_file_clear_hashing (Qt);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
4597 uncache_home_directory ();
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
4598 zero_out_command_line_status_vars ();
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
4599 clear_default_devices ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4600
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4601 #if defined(LOADHIST) && !(defined(LOADHIST_DUMPED) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4602 defined(LOADHIST_BUILTIN))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4603 Vload_history = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4604 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4605 Vshell_file_name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4606
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4607 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4608 gc_full ();
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4609 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4610 garbage_collect_1 ();
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4611 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4612
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4613 /* Run the disksave finalization methods of all live objects. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4614 disksave_object_finalization_1 ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4615
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4616 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4617 /* Zero out the uninitialized (really, unused) part of the containers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4618 for the live strings. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4619 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4620 struct string_chars_block *scb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4621 for (scb = first_string_chars_block; scb; scb = scb->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4622 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4623 int count = sizeof (scb->string_chars) - scb->pos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4625 assert (count >= 0 && count < STRING_CHARS_BLOCK_SIZE);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4626 if (count != 0)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4627 {
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4628 /* from the block's fill ptr to the end */
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4629 memset ((scb->string_chars + scb->pos), 0, count);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4630 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4631 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4632 }
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4633 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4635 /* There, that ought to be enough... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4636
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4637 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4638
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4639 #ifdef ALLOC_TYPE_STATS
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4640
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4641 static Lisp_Object
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4642 gc_plist_hack (const Ascbyte *name, EMACS_INT value, Lisp_Object tail)
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4643 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4644 /* C doesn't have local functions (or closures, or GC, or readable syntax,
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4645 or portable numeric datatypes, or bit-vectors, or characters, or
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4646 arrays, or exceptions, or ...) */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4647 return cons3 (intern (name), make_int (value), tail);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4648 }
2775
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani]
crestani
parents: 2720
diff changeset
4649
5058
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4650 /* Pluralize a lowercase English word stored in BUF, assuming BUF has
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4651 enough space to hold the extra letters (at most 2). */
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4652 static void
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4653 pluralize_word (Ascbyte *buf)
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4654 {
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4655 Bytecount len = strlen (buf);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4656 int upper = 0;
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4657 Ascbyte d, e;
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4658
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4659 if (len == 0 || len == 1)
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4660 goto pluralize_apostrophe_s;
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4661 e = buf[len - 1];
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4662 d = buf[len - 2];
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4663 upper = isupper (e);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4664 e = tolower (e);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4665 d = tolower (d);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4666 if (e == 'y')
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4667 {
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4668 switch (d)
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4669 {
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4670 case 'a':
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4671 case 'e':
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4672 case 'i':
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4673 case 'o':
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4674 case 'u':
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4675 goto pluralize_s;
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4676 default:
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4677 buf[len - 1] = (upper ? 'I' : 'i');
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4678 goto pluralize_es;
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4679 }
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4680 }
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4681 else if (e == 's' || e == 'x' || (e == 'h' && (d == 's' || d == 'c')))
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4682 {
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4683 pluralize_es:
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4684 buf[len++] = (upper ? 'E' : 'e');
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4685 }
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4686 pluralize_s:
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4687 buf[len++] = (upper ? 'S' : 's');
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4688 buf[len] = '\0';
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4689 return;
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4690
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4691 pluralize_apostrophe_s:
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4692 buf[len++] = '\'';
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4693 goto pluralize_s;
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4694 }
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4695
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4696 static void
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4697 pluralize_and_append (Ascbyte *buf, const Ascbyte *name, const Ascbyte *suffix)
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4698 {
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4699 strcpy (buf, name);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4700 pluralize_word (buf);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4701 strcat (buf, suffix);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4702 }
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4703
5158
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4704 void
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4705 finish_object_memory_usage_stats (void)
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4706 {
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4707 /* Here we add up the aggregate values for each statistic, previously
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4708 computed during tick_lrecord_stats(), to get a single combined value
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4709 of non-Lisp memory usage for all objects of each type. We can't
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4710 do this if NEW_GC because nothing like tick_lrecord_stats() gets
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4711 called -- instead, statistics are computed when objects are allocated,
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4712 which is too early to be calling the memory_usage() method. */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4713 #if defined (MEMORY_USAGE_STATS) && !defined (NEW_GC)
5158
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4714 int i;
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4715 for (i = 0; i < countof (lrecord_implementations_table); i++)
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4716 {
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4717 struct lrecord_implementation *imp = lrecord_implementations_table[i];
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4718 if (imp && imp->num_extra_nonlisp_memusage_stats)
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4719 {
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4720 int j;
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4721 for (j = 0; j < imp->num_extra_nonlisp_memusage_stats; j++)
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4722 lrecord_stats[i].nonlisp_bytes_in_use +=
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4723 lrecord_stats[i].stats.othervals[j];
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4724 }
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4725 }
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4726 #endif /* defined (MEMORY_USAGE_STATS) && !defined (NEW_GC) */
5158
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4727 }
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4728
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4729 static Lisp_Object
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4730 object_memory_usage_stats (int set_total_gc_usage)
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4731 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4732 Lisp_Object pl = Qnil;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4733 int i;
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4734 EMACS_INT tgu_val = 0;
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4735
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4736 #ifdef NEW_GC
3461
fd2936bbfc5f [xemacs-hg @ 2006-06-19 18:10:17 by james]
james
parents: 3355
diff changeset
4737 for (i = 0; i < countof (lrecord_implementations_table); i++)
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4738 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4739 if (lrecord_stats[i].instances_in_use != 0)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4740 {
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
4741 Ascbyte buf[255];
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
4742 const Ascbyte *name = lrecord_implementations_table[i]->name;
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4743
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4744 if (lrecord_stats[i].bytes_in_use_including_overhead !=
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4745 lrecord_stats[i].bytes_in_use)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4746 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4747 sprintf (buf, "%s-storage-including-overhead", name);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4748 pl = gc_plist_hack (buf,
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4749 lrecord_stats[i]
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4750 .bytes_in_use_including_overhead,
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4751 pl);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4752 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4753
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4754 sprintf (buf, "%s-storage", name);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4755 pl = gc_plist_hack (buf,
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4756 lrecord_stats[i].bytes_in_use,
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4757 pl);
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4758 tgu_val += lrecord_stats[i].bytes_in_use_including_overhead;
5058
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4759
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4760 pluralize_and_append (buf, name, "-used");
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4761 pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4762 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4763 }
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4764
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4765 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4766
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4767 for (i = 0; i < lrecord_type_count; i++)
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4768 {
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4769 if (lrecord_stats[i].bytes_in_use != 0
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4770 || lrecord_stats[i].bytes_freed != 0
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4771 || lrecord_stats[i].instances_on_free_list != 0)
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4772 {
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4773 Ascbyte buf[255];
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4774 const Ascbyte *name = lrecord_implementations_table[i]->name;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4775
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4776 sprintf (buf, "%s-storage-overhead", name);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4777 pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use_overhead, pl);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4778 tgu_val += lrecord_stats[i].bytes_in_use_overhead;
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4779 sprintf (buf, "%s-storage", name);
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4780 pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use, pl);
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4781 tgu_val += lrecord_stats[i].bytes_in_use;
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4782 #ifdef MEMORY_USAGE_STATS
5158
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4783 if (lrecord_stats[i].nonlisp_bytes_in_use)
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4784 {
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4785 sprintf (buf, "%s-non-lisp-storage", name);
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4786 pl = gc_plist_hack (buf, lrecord_stats[i].nonlisp_bytes_in_use,
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4787 pl);
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4788 tgu_val += lrecord_stats[i].nonlisp_bytes_in_use;
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4789 }
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4790 #endif /* MEMORY_USAGE_STATS */
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4791 pluralize_and_append (buf, name, "-freed");
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4792 if (lrecord_stats[i].instances_freed != 0)
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4793 pl = gc_plist_hack (buf, lrecord_stats[i].instances_freed, pl);
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4794 pluralize_and_append (buf, name, "-on-free-list");
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4795 if (lrecord_stats[i].instances_on_free_list != 0)
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4796 pl = gc_plist_hack (buf, lrecord_stats[i].instances_on_free_list,
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4797 pl);
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4798 pluralize_and_append (buf, name, "-used");
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4799 pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4800 }
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4801 }
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4802
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4803 pl = gc_plist_hack ("long-string-chars-storage-overhead",
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4804 gc_count_long_string_storage_including_overhead -
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4805 (gc_count_string_total_size
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4806 - gc_count_short_string_total_size), pl);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4807 pl = gc_plist_hack ("long-string-chars-storage",
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4808 gc_count_string_total_size
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4809 - gc_count_short_string_total_size, pl);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4810 do
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4811 {
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4812 COUNT_FROB_BLOCK_USAGE (string_chars);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4813 tgu_val += s + s_overhead;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4814 pl = gc_plist_hack ("short-string-chars-storage-overhead", s_overhead, pl);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4815 pl = gc_plist_hack ("short-string-chars-storage", s, pl);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4816 }
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4817 while (0);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
4818
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4819 pl = gc_plist_hack ("long-strings-total-length",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4820 gc_count_string_total_size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4821 - gc_count_short_string_total_size, pl);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4822 pl = gc_plist_hack ("short-strings-total-length",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4823 gc_count_short_string_total_size, pl);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4824 pl = gc_plist_hack ("long-strings-used",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4825 gc_count_num_string_in_use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4826 - gc_count_num_short_string_in_use, pl);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4827 pl = gc_plist_hack ("short-strings-used",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4828 gc_count_num_short_string_in_use, pl);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4829
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4830 #endif /* NEW_GC */
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4831
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4832 if (set_total_gc_usage)
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4833 {
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4834 total_gc_usage = tgu_val;
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4835 total_gc_usage_set = 1;
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4836 }
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4837
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4838 return pl;
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4839 }
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4840
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4841 DEFUN ("object-memory-usage-stats", Fobject_memory_usage_stats, 0, 0, 0, /*
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4842 Return statistics about memory usage of Lisp objects.
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4843 */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4844 ())
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4845 {
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4846 return object_memory_usage_stats (0);
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4847 }
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4848
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4849 #endif /* ALLOC_TYPE_STATS */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4850
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4851 #ifdef MEMORY_USAGE_STATS
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4852
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4853 /* Compute the number of extra memory-usage statistics associated with an
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4854 object. We can't compute this at the time INIT_LISP_OBJECT() is called
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4855 because the value of the `memusage_stats_list' property is generally
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4856 set afterwards. So we compute the values for all types of objects
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4857 after all objects have been initialized. */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4858
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4859 static void
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4860 compute_memusage_stats_length (void)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4861 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4862 int i;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4863
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4864 for (i = 0; i < countof (lrecord_implementations_table); i++)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4865 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4866 int len = 0;
5158
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4867 int nonlisp_len = 0;
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4868 int seen_break = 0;
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4869
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4870 struct lrecord_implementation *imp = lrecord_implementations_table[i];
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4871
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4872 if (!imp)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4873 continue;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4874 /* For some of the early objects, Qnil was not yet initialized at
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4875 the time of object initialization, so it came up as Qnull_pointer.
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4876 Fix that now. */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4877 if (EQ (imp->memusage_stats_list, Qnull_pointer))
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4878 imp->memusage_stats_list = Qnil;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4879 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4880 LIST_LOOP_2 (item, imp->memusage_stats_list)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4881 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4882 if (!NILP (item) && !EQ (item, Qt))
5158
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4883 {
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4884 len++;
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4885 if (!seen_break)
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4886 nonlisp_len++;
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4887 }
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4888 else
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4889 seen_break++;
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4890 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4891 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4892
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4893 imp->num_extra_memusage_stats = len;
5158
9e0b43d3095c more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents: 5157
diff changeset
4894 imp->num_extra_nonlisp_memusage_stats = nonlisp_len;
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4895 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4896 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4897
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4898 DEFUN ("object-memory-usage", Fobject_memory_usage, 1, 1, 0, /*
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4899 Return stats about the memory usage of OBJECT.
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4900 The values returned are in the form of an alist of usage types and byte
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4901 counts. The byte counts attempt to encompass all the memory used
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4902 by the object (separate from the memory logically associated with any
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4903 other object), including internal structures and any malloc()
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4904 overhead associated with them. In practice, the byte counts are
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4905 underestimated because certain memory usage is very hard to determine
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4906 \(e.g. the amount of memory used inside the Xt library or inside the
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4907 X server).
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4908
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4909 Multiple slices of the total memory usage may be returned, separated
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4910 by a nil. Each slice represents a particular view of the memory, a
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4911 particular way of partitioning it into groups. Within a slice, there
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4912 is no overlap between the groups of memory, and each slice collectively
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4913 represents all the memory concerned. The rightmost slice typically
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4914 represents the total memory used plus malloc and dynarr overhead.
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4915
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4916 Slices describing other Lisp objects logically associated with the
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4917 object may be included, separated from other slices by `t' and from
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4918 each other by nil if there is more than one.
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4919
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4920 #### We have to figure out how to handle the memory used by the object
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4921 itself vs. the memory used by substructures. Probably the memory_usage
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4922 method should return info only about substructures and related Lisp
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4923 objects, since the caller can always find and all info about the object
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4924 itself.
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4925 */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4926 (object))
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4927 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4928 struct generic_usage_stats gustats;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4929 struct usage_stats object_stats;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4930 int i;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4931 Lisp_Object val = Qnil;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4932 Lisp_Object stats_list = OBJECT_PROPERTY (object, memusage_stats_list);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4933
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4934 xzero (object_stats);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4935 lisp_object_storage_size (object, &object_stats);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4936
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4937 val = acons (Qobject_actually_requested,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4938 make_int (object_stats.was_requested), val);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4939 val = acons (Qobject_malloc_overhead,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4940 make_int (object_stats.malloc_overhead), val);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4941 assert (!object_stats.dynarr_overhead);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4942 assert (!object_stats.gap_overhead);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4943
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4944 if (!NILP (stats_list))
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4945 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4946 xzero (gustats);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4947 MAYBE_OBJECT_METH (object, memory_usage, (object, &gustats));
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4948
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4949 val = Fcons (Qt, val);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4950 val = acons (Qother_memory_actually_requested,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4951 make_int (gustats.u.was_requested), val);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4952 val = acons (Qother_memory_malloc_overhead,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4953 make_int (gustats.u.malloc_overhead), val);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4954 if (gustats.u.dynarr_overhead)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4955 val = acons (Qother_memory_dynarr_overhead,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4956 make_int (gustats.u.dynarr_overhead), val);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4957 if (gustats.u.gap_overhead)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4958 val = acons (Qother_memory_gap_overhead,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4959 make_int (gustats.u.gap_overhead), val);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4960 val = Fcons (Qnil, val);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4961
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4962 i = 0;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4963 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4964 LIST_LOOP_2 (item, stats_list)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4965 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4966 if (NILP (item) || EQ (item, Qt))
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4967 val = Fcons (item, val);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4968 else
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4969 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4970 val = acons (item, make_int (gustats.othervals[i]), val);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4971 i++;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4972 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4973 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4974 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4975 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4976
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4977 return Fnreverse (val);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4978 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4979
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4980 #endif /* MEMORY_USAGE_STATS */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
4981
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4982 /* Debugging aids. */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4983
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4984 DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /*
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4985 Reclaim storage for Lisp objects no longer needed.
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4986 Return info on amount of space in use:
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4987 ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4988 (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4989 PLIST)
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4990 where `PLIST' is a list of alternating keyword/value pairs providing
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4991 more detailed information.
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4992 Garbage collection happens automatically if you cons more than
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4993 `gc-cons-threshold' bytes of Lisp data since previous garbage collection.
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4994 */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4995 ())
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4996 {
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4997 /* Record total usage for purposes of determining next GC */
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4998 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4999 gc_full ();
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
5000 #else /* not NEW_GC */
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5001 garbage_collect_1 ();
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
5002 #endif /* not NEW_GC */
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5003
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5004 /* This will get set to 1, and total_gc_usage computed, as part of the
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5005 call to object_memory_usage_stats() -- if ALLOC_TYPE_STATS is enabled. */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5006 total_gc_usage_set = 0;
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5007 #ifdef ALLOC_TYPE_STATS
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5008 /* The things we do for backwards-compatibility */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5009 #ifdef NEW_GC
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5010 return
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5011 list6
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5012 (Fcons (make_int (lrecord_stats[lrecord_type_cons].instances_in_use),
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5013 make_int (lrecord_stats[lrecord_type_cons]
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5014 .bytes_in_use_including_overhead)),
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5015 Fcons (make_int (lrecord_stats[lrecord_type_symbol].instances_in_use),
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5016 make_int (lrecord_stats[lrecord_type_symbol]
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5017 .bytes_in_use_including_overhead)),
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5018 Fcons (make_int (lrecord_stats[lrecord_type_marker].instances_in_use),
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5019 make_int (lrecord_stats[lrecord_type_marker]
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5020 .bytes_in_use_including_overhead)),
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5021 make_int (lrecord_stats[lrecord_type_string]
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5022 .bytes_in_use_including_overhead),
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5023 make_int (lrecord_stats[lrecord_type_vector]
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5024 .bytes_in_use_including_overhead),
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5025 object_memory_usage_stats (1));
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5026 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5027 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5028 list6 (Fcons (make_int (gc_count_num_cons_in_use),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5029 make_int (gc_count_num_cons_freelist)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5030 Fcons (make_int (gc_count_num_symbol_in_use),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5031 make_int (gc_count_num_symbol_freelist)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5032 Fcons (make_int (gc_count_num_marker_in_use),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5033 make_int (gc_count_num_marker_freelist)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5034 make_int (gc_count_string_total_size),
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
5035 make_int (lrecord_stats[lrecord_type_vector].bytes_in_use +
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
5036 lrecord_stats[lrecord_type_vector].bytes_freed +
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
5037 lrecord_stats[lrecord_type_vector].bytes_on_free_list),
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5038 object_memory_usage_stats (1));
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5039 #endif /* not NEW_GC */
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5040 #else /* not ALLOC_TYPE_STATS */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5041 return Qnil;
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5042 #endif /* ALLOC_TYPE_STATS */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5043 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5044
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5045 DEFUN ("consing-since-gc", Fconsing_since_gc, 0, 0, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5046 Return the number of bytes consed since the last garbage collection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5047 \"Consed\" is a misnomer in that this actually counts allocation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5048 of all different kinds of objects, not just conses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5050 If this value exceeds `gc-cons-threshold', a garbage collection happens.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5051 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5052 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5053 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5054 return make_int (consing_since_gc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5055 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5056
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
5057 #if 0
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
5058 DEFUN ("memory-limit", Fmemory_limit, 0, 0, 0, /*
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
5059 Return the address of the last byte XEmacs has allocated, divided by 1024.
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
5060 This may be helpful in debugging XEmacs's memory usage.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5061 The value is divided by 1024 to make sure it will fit in a lisp integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5062 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5063 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5064 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5065 return make_int ((EMACS_INT) sbrk (0) / 1024);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5066 }
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
5067 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5068
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5069 DEFUN ("total-memory-usage", Ftotal_memory_usage, 0, 0, 0, /*
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
5070 Return the total number of bytes used by the data segment in XEmacs.
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
5071 This may be helpful in debugging XEmacs's memory usage.
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5072 NOTE: This may or may not be accurate! It is hard to determine this
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5073 value in a system-independent fashion. On Windows, for example, the
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5074 returned number tends to be much greater than reality.
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
5075 */
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
5076 ())
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
5077 {
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
5078 return make_int (total_data_usage ());
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
5079 }
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
5080
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5081 #ifdef ALLOC_TYPE_STATS
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5082 DEFUN ("total-object-memory-usage", Ftotal_object_memory_usage, 0, 0, 0, /*
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5083 Return total number of bytes used for object storage in XEmacs.
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5084 This may be helpful in debugging XEmacs's memory usage.
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5085 See also `consing-since-gc' and `object-memory-usage-stats'.
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5086 */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5087 ())
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5088 {
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5089 return make_int (total_gc_usage + consing_since_gc);
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5090 }
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5091 #endif /* ALLOC_TYPE_STATS */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5092
4803
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5093 #ifdef USE_VALGRIND
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5094 DEFUN ("valgrind-leak-check", Fvalgrind_leak_check, 0, 0, "", /*
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5095 Ask valgrind to perform a memory leak check.
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5096 The results of the leak check are sent to stderr.
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5097 */
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5098 ())
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5099 {
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5100 VALGRIND_DO_LEAK_CHECK;
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5101 return Qnil;
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5102 }
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5103
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5104 DEFUN ("valgrind-quick-leak-check", Fvalgrind_quick_leak_check, 0, 0, "", /*
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5105 Ask valgrind to perform a quick memory leak check.
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5106 This just prints a summary of leaked memory, rather than all the details.
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5107 The results of the leak check are sent to stderr.
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5108 */
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5109 ())
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5110 {
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5111 VALGRIND_DO_QUICK_LEAK_CHECK;
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5112 return Qnil;
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5113 }
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5114 #endif /* USE_VALGRIND */
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5115
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
5116 void
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
5117 recompute_funcall_allocation_flag (void)
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
5118 {
887
ccc3177ef10b [xemacs-hg @ 2002-06-28 14:21:41 by michaels]
michaels
parents: 872
diff changeset
5119 funcall_allocation_flag =
ccc3177ef10b [xemacs-hg @ 2002-06-28 14:21:41 by michaels]
michaels
parents: 872
diff changeset
5120 need_to_garbage_collect ||
ccc3177ef10b [xemacs-hg @ 2002-06-28 14:21:41 by michaels]
michaels
parents: 872
diff changeset
5121 need_to_check_c_alloca ||
ccc3177ef10b [xemacs-hg @ 2002-06-28 14:21:41 by michaels]
michaels
parents: 872
diff changeset
5122 need_to_signal_post_gc;
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
5123 }
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
5124
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5125 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5126 object_dead_p (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5127 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5128 return ((BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj))) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5129 (FRAMEP (obj) && !FRAME_LIVE_P (XFRAME (obj))) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5130 (WINDOWP (obj) && !WINDOW_LIVE_P (XWINDOW (obj))) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5131 (DEVICEP (obj) && !DEVICE_LIVE_P (XDEVICE (obj))) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5132 (CONSOLEP (obj) && !CONSOLE_LIVE_P (XCONSOLE (obj))) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5133 (EVENTP (obj) && !EVENT_LIVE_P (XEVENT (obj))) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5134 (EXTENTP (obj) && !EXTENT_LIVE_P (XEXTENT (obj))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5135 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5136
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5137 #ifdef ALLOC_TYPE_STATS
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5139 /* Attempt to determine the actual amount of space that is used for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5140 the block allocated starting at PTR, supposedly of size "CLAIMED_SIZE".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5142 It seems that the following holds:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5144 1. When using the old allocator (malloc.c):
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5146 -- blocks are always allocated in chunks of powers of two. For
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5147 each block, there is an overhead of 8 bytes if rcheck is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5148 defined, 20 bytes if it is defined. In other words, a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5149 one-byte allocation needs 8 bytes of overhead for a total of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5150 9 bytes, and needs to have 16 bytes of memory chunked out for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5151 it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5153 2. When using the new allocator (gmalloc.c):
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5155 -- blocks are always allocated in chunks of powers of two up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5156 to 4096 bytes. Larger blocks are allocated in chunks of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5157 an integral multiple of 4096 bytes. The minimum block
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5158 size is 2*sizeof (void *), or 16 bytes if SUNOS_LOCALTIME_BUG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5159 is defined. There is no per-block overhead, but there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5160 is an overhead of 3*sizeof (size_t) for each 4096 bytes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5161 allocated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5163 3. When using the system malloc, anything goes, but they are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5164 generally slower and more space-efficient than the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5165 allocators. One possibly reasonable assumption to make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5166 for want of better data is that sizeof (void *), or maybe
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5167 2 * sizeof (void *), is required as overhead and that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5168 blocks are allocated in the minimum required size except
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5169 that some minimum block size is imposed (e.g. 16 bytes). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5170
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
5171 Bytecount
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
5172 malloced_storage_size (void * UNUSED (ptr), Bytecount claimed_size,
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5173 struct usage_stats *stats)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5174 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
5175 Bytecount orig_claimed_size = claimed_size;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5176
4735
80d74fed5399 Remove "old" GNU malloc in src/malloc.c, and all references to it. Drop the
Jerry James <james@xemacs.org>
parents: 4693
diff changeset
5177 #ifndef SYSTEM_MALLOC
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
5178 if (claimed_size < (Bytecount) (2 * sizeof (void *)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5179 claimed_size = 2 * sizeof (void *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5180 # ifdef SUNOS_LOCALTIME_BUG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5181 if (claimed_size < 16)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5182 claimed_size = 16;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5183 # endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5184 if (claimed_size < 4096)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5185 {
2260
f913c1545598 [xemacs-hg @ 2004-09-10 18:46:58 by james]
james
parents: 1983
diff changeset
5186 /* fxg: rename log->log2 to supress gcc3 shadow warning */
f913c1545598 [xemacs-hg @ 2004-09-10 18:46:58 by james]
james
parents: 1983
diff changeset
5187 int log2 = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5189 /* compute the log base two, more or less, then use it to compute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5190 the block size needed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5191 claimed_size--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5192 /* It's big, it's heavy, it's wood! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5193 while ((claimed_size /= 2) != 0)
2260
f913c1545598 [xemacs-hg @ 2004-09-10 18:46:58 by james]
james
parents: 1983
diff changeset
5194 ++log2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5195 claimed_size = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5196 /* It's better than bad, it's good! */
2260
f913c1545598 [xemacs-hg @ 2004-09-10 18:46:58 by james]
james
parents: 1983
diff changeset
5197 while (log2 > 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5198 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5199 claimed_size *= 2;
2260
f913c1545598 [xemacs-hg @ 2004-09-10 18:46:58 by james]
james
parents: 1983
diff changeset
5200 log2--;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5201 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5202 /* We have to come up with some average about the amount of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5203 blocks used. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
5204 if ((Bytecount) (rand () & 4095) < claimed_size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5205 claimed_size += 3 * sizeof (void *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5206 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5207 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5208 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5209 claimed_size += 4095;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5210 claimed_size &= ~4095;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5211 claimed_size += (claimed_size / 4096) * 3 * sizeof (size_t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5212 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5213
4735
80d74fed5399 Remove "old" GNU malloc in src/malloc.c, and all references to it. Drop the
Jerry James <james@xemacs.org>
parents: 4693
diff changeset
5214 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5216 if (claimed_size < 16)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5217 claimed_size = 16;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5218 claimed_size += 2 * sizeof (void *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5219
4735
80d74fed5399 Remove "old" GNU malloc in src/malloc.c, and all references to it. Drop the
Jerry James <james@xemacs.org>
parents: 4693
diff changeset
5220 #endif /* system allocator */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5222 if (stats)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5223 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5224 stats->was_requested += orig_claimed_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5225 stats->malloc_overhead += claimed_size - orig_claimed_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5226 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5227 return claimed_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5228 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5229
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5230 #ifndef NEW_GC
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5231 static Bytecount
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5232 fixed_type_block_overhead (Bytecount size, Bytecount per_block)
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5233 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
5234 Bytecount overhead = 0;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
5235 Bytecount storage_size = malloced_storage_size (0, per_block, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5236 while (size >= per_block)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5237 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5238 size -= per_block;
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5239 overhead += storage_size - per_block;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5240 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5241 if (rand () % per_block < size)
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5242 overhead += storage_size - per_block;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5243 return overhead;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5244 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5245 #endif /* not NEW_GC */
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5246
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5247 Bytecount
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5248 lisp_object_storage_size (Lisp_Object obj, struct usage_stats *ustats)
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5249 {
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5250 #ifndef NEW_GC
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5251 const struct lrecord_implementation *imp =
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5252 XRECORD_LHEADER_IMPLEMENTATION (obj);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5253 #endif /* not NEW_GC */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5254 Bytecount size = lisp_object_size (obj);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5255
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5256 #ifdef NEW_GC
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5257 return mc_alloced_storage_size (size, ustats);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5258 #else
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5259 if (imp->frob_block_p)
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5260 {
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5261 Bytecount overhead =
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5262 /* #### Always using cons_block is incorrect but close; only
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5263 string_chars_block is significantly different in size, and
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5264 it won't ever be seen in this function */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5265 fixed_type_block_overhead (size, sizeof (struct cons_block));
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5266 if (ustats)
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5267 {
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5268 ustats->was_requested += size;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5269 ustats->malloc_overhead += overhead;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5270 }
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5271 return size + overhead;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5272 }
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5273 else
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5274 return malloced_storage_size (XPNTR (obj), size, ustats);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5275 #endif
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5276 }
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5277
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5278 #endif /* ALLOC_TYPE_STATS */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5280
5160
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5281 /************************************************************************/
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5282 /* Initialization */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5283 /************************************************************************/
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents: 5159
diff changeset
5284
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5285 /* Initialization */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5286 static void
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5287 common_init_alloc_early (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5288 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5289 #ifndef Qzero
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5290 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5291 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5292
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5293 #ifndef Qnull_pointer
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5294 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5295 so the following is actually a no-op. */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
5296 Qnull_pointer = wrap_pointer_1 (0);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5297 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5298
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5299 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5300 breathing_space = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5301 all_lcrecords = 0;
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5302 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5303 ignore_malloc_warnings = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5304 #ifdef DOUG_LEA_MALLOC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5305 mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5306 mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5307 #if 0 /* Moved to emacs.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5308 mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5309 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5310 #endif
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
5311 #ifndef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5312 init_string_chars_alloc ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5313 init_string_alloc ();
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5314 /* #### Is it intentional that this is called twice? --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5315 init_string_chars_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5316 init_cons_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5317 init_symbol_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5318 init_compiled_function_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5319 init_float_alloc ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5320 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5321 init_bignum_alloc ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5322 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5323 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5324 init_ratio_alloc ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5325 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5326 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5327 init_bigfloat_alloc ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5328 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5329 init_marker_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5330 init_extent_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5331 init_event_alloc ();
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5332 #ifdef EVENT_DATA_AS_OBJECTS
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5333 init_key_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5334 init_button_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5335 init_motion_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5336 init_process_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5337 init_timeout_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5338 init_magic_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5339 init_magic_eval_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5340 init_eval_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5341 init_misc_user_data_alloc ();
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5342 #endif /* EVENT_DATA_AS_OBJECTS */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5343 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5344
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5345 ignore_malloc_warnings = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5346
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
5347 if (staticpros_nodump)
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
5348 Dynarr_free (staticpros_nodump);
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
5349 staticpros_nodump = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
5350 Dynarr_resize (staticpros_nodump, 100); /* merely a small optimization */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5351 #ifdef DEBUG_XEMACS
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5352 if (staticpro_nodump_names)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5353 Dynarr_free (staticpro_nodump_names);
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
5354 staticpro_nodump_names = Dynarr_new2 (const_Ascbyte_ptr_dynarr,
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
5355 const Ascbyte *);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5356 Dynarr_resize (staticpro_nodump_names, 100); /* ditto */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5357 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5358
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5359 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5360 mcpros = Dynarr_new2 (Lisp_Object_dynarr, Lisp_Object);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5361 Dynarr_resize (mcpros, 1410); /* merely a small optimization */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5362 dump_add_root_block_ptr (&mcpros, &mcpros_description);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5363 #ifdef DEBUG_XEMACS
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
5364 mcpro_names = Dynarr_new2 (const_Ascbyte_ptr_dynarr, const Ascbyte *);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5365 Dynarr_resize (mcpro_names, 1410); /* merely a small optimization */
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
5366 dump_add_root_block_ptr (&mcpro_names,
4964
1f509f82c8c9 fix compile error
Ben Wing <ben@xemacs.org>
parents: 4962
diff changeset
5367 &const_Ascbyte_ptr_dynarr_description);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5368 #endif
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5369 #endif /* NEW_GC */
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5370
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5371 consing_since_gc = 0;
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
5372 need_to_check_c_alloca = 0;
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
5373 funcall_allocation_flag = 0;
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
5374 funcall_alloca_count = 0;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
5375
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5376 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5377 debug_string_purity = 0;
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5378 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5379
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
5380 #ifdef ERROR_CHECK_TYPES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5381 ERROR_ME.really_unlikely_name_to_have_accidentally_in_a_non_errb_structure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5382 666;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5383 ERROR_ME_NOT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5384 really_unlikely_name_to_have_accidentally_in_a_non_errb_structure = 42;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5385 ERROR_ME_WARN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5386 really_unlikely_name_to_have_accidentally_in_a_non_errb_structure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5387 3333632;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
5388 ERROR_ME_DEBUG_WARN.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
5389 really_unlikely_name_to_have_accidentally_in_a_non_errb_structure =
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
5390 8675309;
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
5391 #endif /* ERROR_CHECK_TYPES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5392 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5393
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5394 #ifndef NEW_GC
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5395 static void
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5396 init_lcrecord_lists (void)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5397 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5398 int i;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5399
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5400 for (i = 0; i < countof (lrecord_implementations_table); i++)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5401 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5402 all_lcrecord_lists[i] = Qzero; /* Qnil not yet set */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5403 staticpro_nodump (&all_lcrecord_lists[i]);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5404 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5405 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5406 #endif /* not NEW_GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5407
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5408 void
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5409 init_alloc_early (void)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5410 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5411 #if defined (__cplusplus) && defined (ERROR_CHECK_GC)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5412 static struct gcpro initial_gcpro;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5413
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5414 initial_gcpro.next = 0;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5415 initial_gcpro.var = &Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5416 initial_gcpro.nvars = 1;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5417 gcprolist = &initial_gcpro;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5418 #else
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5419 gcprolist = 0;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5420 #endif /* defined (__cplusplus) && defined (ERROR_CHECK_GC) */
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5421 }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5422
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5423 static void
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5424 reinit_alloc_objects_early (void)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5425 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5426 OBJECT_HAS_METHOD (string, getprop);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5427 OBJECT_HAS_METHOD (string, putprop);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5428 OBJECT_HAS_METHOD (string, remprop);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5429 OBJECT_HAS_METHOD (string, plist);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5430 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5431
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5432 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5433 reinit_alloc_early (void)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5434 {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5435 common_init_alloc_early ();
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5436 #ifndef NEW_GC
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5437 init_lcrecord_lists ();
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5438 #endif /* not NEW_GC */
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5439 reinit_alloc_objects_early ();
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5440 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5441
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5442 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5443 init_alloc_once_early (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5444 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5445 common_init_alloc_early ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5446
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5447 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5448 int i;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5449 for (i = 0; i < countof (lrecord_implementations_table); i++)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5450 lrecord_implementations_table[i] = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5451 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5452
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
5453 dump_add_opaque (lrecord_uid_counter, sizeof (lrecord_uid_counter));
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
5454
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
5455 staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
5456 Dynarr_resize (staticpros, 1410); /* merely a small optimization */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
5457 dump_add_root_block_ptr (&staticpros, &staticpros_description);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5458 #ifdef DEBUG_XEMACS
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
5459 staticpro_names = Dynarr_new2 (const_Ascbyte_ptr_dynarr, const Ascbyte *);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5460 Dynarr_resize (staticpro_names, 1410); /* merely a small optimization */
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
5461 dump_add_root_block_ptr (&staticpro_names,
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
5462 &const_Ascbyte_ptr_dynarr_description);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5463 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5464
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5465 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5466 mcpros = Dynarr_new2 (Lisp_Object_dynarr, Lisp_Object);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5467 Dynarr_resize (mcpros, 1410); /* merely a small optimization */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5468 dump_add_root_block_ptr (&mcpros, &mcpros_description);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5469 #ifdef DEBUG_XEMACS
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
5470 mcpro_names = Dynarr_new2 (const_Ascbyte_ptr_dynarr, const Ascbyte *);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5471 Dynarr_resize (mcpro_names, 1410); /* merely a small optimization */
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
5472 dump_add_root_block_ptr (&mcpro_names,
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
5473 &const_Ascbyte_ptr_dynarr_description);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5474 #endif
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5475 #else /* not NEW_GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5476 init_lcrecord_lists ();
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5477 #endif /* not NEW_GC */
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5478
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5479 INIT_LISP_OBJECT (cons);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5480 INIT_LISP_OBJECT (vector);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5481 INIT_LISP_OBJECT (string);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5482
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5483 #ifdef NEW_GC
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5484 INIT_LISP_OBJECT (string_indirect_data);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5485 INIT_LISP_OBJECT (string_direct_data);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5486 #endif /* NEW_GC */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5487 #ifndef NEW_GC
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5488 INIT_LISP_OBJECT (lcrecord_list);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5489 INIT_LISP_OBJECT (free);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5490 #endif /* not NEW_GC */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5491
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5492 reinit_alloc_objects_early ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5493 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5495 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5496 syms_of_alloc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5497 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5498 DEFSYMBOL (Qgarbage_collecting);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5499
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5500 #ifdef MEMORY_USAGE_STATS
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5501 DEFSYMBOL (Qobject_actually_requested);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5502 DEFSYMBOL (Qobject_malloc_overhead);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5503 DEFSYMBOL (Qother_memory_actually_requested);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5504 DEFSYMBOL (Qother_memory_malloc_overhead);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5505 DEFSYMBOL (Qother_memory_dynarr_overhead);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5506 DEFSYMBOL (Qother_memory_gap_overhead);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5507 #endif /* MEMORY_USAGE_STATS */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5508
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5509 DEFSUBR (Fcons);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5510 DEFSUBR (Flist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5511 DEFSUBR (Fvector);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5512 DEFSUBR (Fbit_vector);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5513 DEFSUBR (Fmake_byte_code);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5514 DEFSUBR (Fmake_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5515 DEFSUBR (Fmake_vector);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5516 DEFSUBR (Fmake_bit_vector);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5517 DEFSUBR (Fmake_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5518 DEFSUBR (Fstring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5519 DEFSUBR (Fmake_symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5520 DEFSUBR (Fmake_marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5521 DEFSUBR (Fpurecopy);
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5522 #ifdef ALLOC_TYPE_STATS
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5523 DEFSUBR (Fobject_memory_usage_stats);
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5524 DEFSUBR (Ftotal_object_memory_usage);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5525 #endif /* ALLOC_TYPE_STATS */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5526 #ifdef MEMORY_USAGE_STATS
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5527 DEFSUBR (Fobject_memory_usage);
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5528 #endif /* MEMORY_USAGE_STATS */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5529 DEFSUBR (Fgarbage_collect);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
5530 #if 0
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5531 DEFSUBR (Fmemory_limit);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
5532 #endif
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5533 DEFSUBR (Ftotal_memory_usage);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5534 DEFSUBR (Fconsing_since_gc);
4803
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5535 #ifdef USE_VALGRIND
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5536 DEFSUBR (Fvalgrind_leak_check);
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5537 DEFSUBR (Fvalgrind_quick_leak_check);
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5538 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5539 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5540
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5541 void
5157
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5542 reinit_vars_of_alloc (void)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5543 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5544 #ifdef MEMORY_USAGE_STATS
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5545 compute_memusage_stats_length ();
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5546 #endif /* MEMORY_USAGE_STATS */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5547 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5548
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents: 5146
diff changeset
5549 void
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5550 vars_of_alloc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5551 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5552 #ifdef DEBUG_XEMACS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5553 DEFVAR_INT ("debug-allocation", &debug_allocation /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5554 If non-zero, print out information to stderr about all objects allocated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5555 See also `debug-allocation-backtrace-length'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5556 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5557 debug_allocation = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5558
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5559 DEFVAR_INT ("debug-allocation-backtrace-length",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5560 &debug_allocation_backtrace_length /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5561 Length (in stack frames) of short backtrace printed out by `debug-allocation'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5562 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5563 debug_allocation_backtrace_length = 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5564 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5566 DEFVAR_BOOL ("purify-flag", &purify_flag /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5567 Non-nil means loading Lisp code in order to dump an executable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5568 This means that certain objects should be allocated in readonly space.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5569 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5570 }