annotate src/alloc.c @ 5146:88bd4f3ef8e4

make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2010-03-15 Ben Wing <ben@xemacs.org> * alloc.c: * alloc.c (c_readonly): * alloc.c (deadbeef_memory): * alloc.c (make_compiled_function): * alloc.c (make_button_data): * alloc.c (make_motion_data): * alloc.c (make_process_data): * alloc.c (make_timeout_data): * alloc.c (make_magic_data): * alloc.c (make_magic_eval_data): * alloc.c (make_eval_data): * alloc.c (make_misc_user_data): * alloc.c (noseeum_make_marker): * alloc.c (ADDITIONAL_FREE_string): * alloc.c (common_init_alloc_early): * alloc.c (init_alloc_once_early): * bytecode.c (print_compiled_function): * bytecode.c (mark_compiled_function): * casetab.c: * casetab.c (print_case_table): * console.c: * console.c (print_console): * database.c (print_database): * database.c (finalize_database): * device-msw.c (sync_printer_with_devmode): * device-msw.c (print_devmode): * device-msw.c (finalize_devmode): * device.c: * device.c (print_device): * elhash.c: * elhash.c (print_hash_table): * eval.c (print_multiple_value): * eval.c (mark_multiple_value): * events.c (deinitialize_event): * events.c (print_event): * events.c (event_equal): * extents.c: * extents.c (soe_dump): * extents.c (soe_insert): * extents.c (soe_delete): * extents.c (soe_move): * extents.c (extent_fragment_update): * extents.c (print_extent_1): * extents.c (print_extent): * extents.c (vars_of_extents): * frame.c: * frame.c (print_frame): * free-hook.c: * free-hook.c (check_free): * glyphs.c: * glyphs.c (print_image_instance): * glyphs.c (print_glyph): * gui.c: * gui.c (copy_gui_item): * hash.c: * hash.c (NULL_ENTRY): * hash.c (KEYS_DIFFER_P): * keymap.c (print_keymap): * keymap.c (MARKED_SLOT): * lisp.h: * lrecord.h: * lrecord.h (LISP_OBJECT_UID): * lrecord.h (set_lheader_implementation): * lrecord.h (struct old_lcrecord_header): * lstream.c (print_lstream): * lstream.c (finalize_lstream): * marker.c (print_marker): * marker.c (marker_equal): * mc-alloc.c (visit_all_used_page_headers): * mule-charset.c: * mule-charset.c (print_charset): * objects.c (print_color_instance): * objects.c (print_font_instance): * objects.c (finalize_font_instance): * opaque.c (print_opaque): * opaque.c (print_opaque_ptr): * opaque.c (equal_opaque_ptr): * print.c (internal_object_printer): * print.c (enum printing_badness): * rangetab.c (print_range_table): * rangetab.c (range_table_equal): * specifier.c (print_specifier): * specifier.c (finalize_specifier): * symbols.c: * symbols.c (print_symbol_value_magic): * tooltalk.c: * tooltalk.c (print_tooltalk_message): * tooltalk.c (print_tooltalk_pattern): * window.c (print_window): * window.c (debug_print_window): (1) Make lrecord UID's have a separate UID space for each object. Otherwise, with 20-bit UID's, we rapidly wrap around, especially when common objects like conses and strings increment the UID value for every object created. (Originally I tried making two UID spaces, one for objects that always print readably and hence don't display the UID, and one for other objects. But certain objects like markers for which a UID is displayed are still generated rapidly enough that UID overflow is a serious issue.) This also has the advantage of making UID values smaller, hence easier to remember -- their main purpose is to make it easier to keep track of different objects of the same type when debugging code. Make sure we dump lrecord UID's so that we don't have problems with pdumped and non-dumped objects having the same UID. (2) Display UID's consistently whenever an object (a) doesn't consistently print readably (objects like cons and string, which always print readably, can't display a UID), and (b) doesn't otherwise have a unique property that makes objects of a particular type distinguishable. (E.g. buffers didn't and still don't print an ID, but the buffer name uniquely identifies the buffer.) Some types, such as event, extent, compiled-function, didn't always (or didn't ever) display an ID; others (such as marker, extent, lstream, opaque, opaque-ptr, any object using internal_object_printer()) used to display the actual machine pointer instead. (3) Rename NORMAL_LISP_OBJECT_UID to LISP_OBJECT_UID; make it work over all Lisp objects and take a Lisp object, not a struct pointer. (4) Some misc cleanups in alloc.c, elhash.c. (5) Change code in events.c that "deinitializes" an event so that it doesn't increment the event UID counter in the process. Also use deadbeef_memory() to overwrite memory instead of doing the same with custom code. In the process, make deadbeef_memory() in alloc.c always available, and delete extraneous copy in mc-alloc.c. Also capitalize all uses of 0xDEADBEEF. Similarly in elhash.c call deadbeef_memory(). (6) Resurrect "debug SOE" code in extents.c. Make it conditional on DEBUG_XEMACS and on a `debug-soe' variable, rather than on SOE_DEBUG. Make it output to stderr, not stdout. (7) Delete some custom print methods that were identical to external_object_printer().
author Ben Wing <ben@xemacs.org>
date Mon, 15 Mar 2010 16:35:38 -0500
parents f965e31a35f0
children 641d0cdd1d00 1fae11d56ad2
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. */
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
108 const struct lrecord_implementation *lrecord_implementations_table[(int)lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT];
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
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
116 /* 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
117 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
118
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
119 /* 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
120 #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
121 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
122 #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
123
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
124 #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
125
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 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
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 #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
129
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 /* 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
131 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
132 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
133 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
134
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
135 /* 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
136 Ffuncall() faster */
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
137 #define INCREMENT_CONS_COUNTER_1(size) \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
138 do \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
139 { \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
140 consing_since_gc += (size); \
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
141 total_consing += (size); \
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
142 if (profiling_active) \
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
143 profile_record_consing (size); \
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
144 recompute_need_to_garbage_collect (); \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
145 } while (0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 #define debug_allocation_backtrace() \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 if (debug_allocation_backtrace_length > 0) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 debug_short_backtrace (debug_allocation_backtrace_length); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 #ifdef DEBUG_XEMACS
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
154 #define INCREMENT_CONS_COUNTER(foosize, type) \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
155 do { \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
156 if (debug_allocation) \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
157 { \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
158 stderr_out ("allocating %s (size %ld)\n", type, \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
159 (long) foosize); \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
160 debug_allocation_backtrace (); \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
161 } \
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
162 INCREMENT_CONS_COUNTER_1 (foosize); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 #define NOSEEUM_INCREMENT_CONS_COUNTER(foosize, type) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 if (debug_allocation > 1) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 { \
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
168 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
169 (long) foosize); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 debug_allocation_backtrace (); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 INCREMENT_CONS_COUNTER_1 (foosize); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 #define INCREMENT_CONS_COUNTER(size, type) INCREMENT_CONS_COUNTER_1 (size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 #define NOSEEUM_INCREMENT_CONS_COUNTER(size, type) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 INCREMENT_CONS_COUNTER_1 (size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
180 #ifdef NEW_GC
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
181 /* [[ 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
182 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
183 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
184 is not needed. ]] -- not accurate! */
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
185 #define DECREMENT_CONS_COUNTER(size) do { \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
186 consing_since_gc -= (size); \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
187 total_consing -= (size); \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
188 if (profiling_active) \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
189 profile_record_unconsing (size); \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
190 if (consing_since_gc < 0) \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
191 consing_since_gc = 0; \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
192 } while (0)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
193 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 #define DECREMENT_CONS_COUNTER(size) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 consing_since_gc -= (size); \
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
196 total_consing -= (size); \
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
197 if (profiling_active) \
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
198 profile_record_unconsing (size); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 if (consing_since_gc < 0) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 consing_since_gc = 0; \
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
201 recompute_need_to_garbage_collect (); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 } while (0)
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
203 #endif /*not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
205 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 c_readonly (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 return POINTER_TYPE_P (XTYPE (obj)) && C_READONLY (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
211 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 lisp_readonly (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 return POINTER_TYPE_P (XTYPE (obj)) && LISP_READONLY (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 /* Maximum amount of C stack to save when a GC happens. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 #ifndef MAX_SAVE_STACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 #define MAX_SAVE_STACK 0 /* 16000 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 /* Non-zero means ignore malloc warnings. Set during initialization. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 int ignore_malloc_warnings;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
230 #ifndef NEW_GC
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
231 void *breathing_space;
428
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 release_breathing_space (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 if (breathing_space)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 void *tmp = breathing_space;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 breathing_space = 0;
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4969
diff changeset
240 xfree (tmp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
243 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
245 static void
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
246 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
247 {
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
248 if (!val)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
249 return;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
250 if ((char *) val + size > (char *) maximum_address_seen)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
251 maximum_address_seen = (char *) val + size;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
252 if (!minimum_address_seen)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
253 minimum_address_seen =
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
254 #if SIZEOF_VOID_P == 8
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
255 (void *) 0xFFFFFFFFFFFFFFFF;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
256 #else
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
257 (void *) 0xFFFFFFFF;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
258 #endif
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
259 if ((char *) val < (char *) minimum_address_seen)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
260 minimum_address_seen = (char *) val;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
261 }
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
262
1315
70921960b980 [xemacs-hg @ 2003-02-20 08:19:28 by ben]
ben
parents: 1292
diff changeset
263 #ifdef ERROR_CHECK_MALLOC
3176
1c2a4e4e81d9 [xemacs-hg @ 2005-12-25 11:21:45 by aidan]
aidan
parents: 3170
diff changeset
264 static int in_malloc;
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1318
diff changeset
265 extern int regex_malloc_disallowed;
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
266
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
267 #define MALLOC_BEGIN() \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
268 do \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
269 { \
3176
1c2a4e4e81d9 [xemacs-hg @ 2005-12-25 11:21:45 by aidan]
aidan
parents: 3170
diff changeset
270 assert (!in_malloc); \
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
271 assert (!regex_malloc_disallowed); \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
272 in_malloc = 1; \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
273 } \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
274 while (0)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
275
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
276 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
277 #define FREE_OR_REALLOC_BEGIN(block) \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
278 do \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
279 { \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
280 /* 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
281 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
282 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
283 assert (block != (void *) DEADBEEF_CONSTANT); \
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
284 MALLOC_BEGIN (); \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
285 } \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
286 while (0)
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
287 #else /* not NEW_GC */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
288 #define FREE_OR_REALLOC_BEGIN(block) \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
289 do \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
290 { \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
291 /* 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
292 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
293 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
294 assert (block != (void *) DEADBEEF_CONSTANT); \
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
295 /* 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
296 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
297 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
298 DUMPEDP. */ \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
299 assert (!DUMPEDP (block)); \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
300 MALLOC_BEGIN (); \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
301 } \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
302 while (0)
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
303 #endif /* not NEW_GC */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
304
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
305 #define MALLOC_END() \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
306 do \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
307 { \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
308 in_malloc = 0; \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
309 } \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
310 while (0)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
311
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
312 #else /* ERROR_CHECK_MALLOC */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
313
2658
a48989ca6db3 [xemacs-hg @ 2005-03-13 09:20:58 by crestani]
crestani
parents: 2650
diff changeset
314 #define MALLOC_BEGIN()
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
315 #define FREE_OR_REALLOC_BEGIN(block)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
316 #define MALLOC_END()
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
317
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
318 #endif /* ERROR_CHECK_MALLOC */
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 static void
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
321 malloc_after (void *val, Bytecount size)
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 if (!val && size != 0)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
324 memory_full ();
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
325 set_alloc_mins_and_maxes (val, size);
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
3305
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
328 /* 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
329 void
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
330 malloc_warning (const char *str)
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
331 {
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
332 if (ignore_malloc_warnings)
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
333 return;
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
334
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
335 /* 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
336 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
337 is already finished (malloc_warning is called via
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
338 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
339 malloc_warning). */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
340 MALLOC_END ();
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
341
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
342 warn_when_safe
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
343 (Qmemory, Qemergency,
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
344 "%s\n"
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
345 "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
346 "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
347 "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
348 str);
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
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
351 /* Called if malloc returns zero */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
352 DOESNT_RETURN
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
353 memory_full (void)
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
354 {
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
355 /* Force a GC next time eval is called.
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
356 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
357 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
358 */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
359 consing_since_gc = gc_cons_threshold + 1;
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
360 recompute_need_to_garbage_collect ();
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
361 #ifdef NEW_GC
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
362 /* 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
363 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
364 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
365 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
366 if (memory_shortage)
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
367 {
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
368 fprintf (stderr, "Memory full, cannot recover.\n");
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
369 ABORT ();
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
370 }
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
371 fprintf (stderr,
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
372 "Memory full, try to recover.\n"
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
373 "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
374 memory_shortage++;
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
375 #else /* not NEW_GC */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
376 release_breathing_space ();
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
377 #endif /* not NEW_GC */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
378
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
379 /* Flush some histories which might conceivably contain garbalogical
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
380 inhibitors. */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
381 if (!NILP (Fboundp (Qvalues)))
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
382 Fset (Qvalues, Qnil);
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
383 Vcommand_history = Qnil;
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
384
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
385 out_of_memory ("Memory exhausted", Qunbound);
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
386 }
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani]
crestani
parents: 3304
diff changeset
387
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
388 /* like malloc, calloc, realloc, free but:
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
389
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
390 -- check for no memory left
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
391 -- set internal mins and maxes
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
392 -- 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
393 */
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
394
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 #undef xmalloc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 void *
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
397 xmalloc (Bytecount size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
399 void *val;
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
400 MALLOC_BEGIN ();
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
401 val = malloc (size);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
402 MALLOC_END ();
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
403 malloc_after (val, size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 #undef xcalloc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 static void *
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
409 xcalloc (Elemcount nelem, Bytecount elsize)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
411 void *val;
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
412 MALLOC_BEGIN ();
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1276
diff changeset
413 val= calloc (nelem, elsize);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
414 MALLOC_END ();
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
415 malloc_after (val, nelem * elsize);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 void *
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
420 xmalloc_and_zero (Bytecount size)
428
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 return xcalloc (size, sizeof (char));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 #undef xrealloc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 void *
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
427 xrealloc (void *block, Bytecount size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
429 FREE_OR_REALLOC_BEGIN (block);
551
e9a3f8b4de53 [xemacs-hg @ 2001-05-21 05:26:06 by martinb]
martinb
parents: 460
diff changeset
430 block = realloc (block, size);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
431 MALLOC_END ();
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
432 malloc_after (block, size);
551
e9a3f8b4de53 [xemacs-hg @ 2001-05-21 05:26:06 by martinb]
martinb
parents: 460
diff changeset
433 return block;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 xfree_1 (void *block)
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 #ifdef ERROR_CHECK_MALLOC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 assert (block);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 #endif /* ERROR_CHECK_MALLOC */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
442 FREE_OR_REALLOC_BEGIN (block);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 free (block);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
444 MALLOC_END ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446
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
447 void
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
448 deadbeef_memory (void *ptr, Bytecount size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
450 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
451 Bytecount beefs = size >> 2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 /* In practice, size will always be a multiple of four. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 while (beefs--)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
455 (*ptr4++) = 0xDEADBEEF; /* -559038737 base 10 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 #undef xstrdup
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 char *
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
460 xstrdup (const char *str)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 int len = strlen (str) + 1; /* for stupid terminating 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 void *val = xmalloc (len);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
464
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 if (val == 0) return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 return (char *) memcpy (val, str, len);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 #ifdef NEED_STRDUP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 char *
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
471 strdup (const char *s)
428
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 return xstrdup (s);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 #endif /* NEED_STRDUP */
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
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
478 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 static void *
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
480 allocate_lisp_storage (Bytecount size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
482 void *val = xmalloc (size);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
483 /* 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
484 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
485 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
486 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
487 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
488 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
489 get freed?) */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
490
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
491 /* 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
492 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
493 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
494 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
495 redisplay structures are allocated separately. */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
496 memset (val, 0, size);
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
497
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
498 if (need_to_check_c_alloca)
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
499 xemacs_c_alloca (0);
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
500
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
501 return val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
503 #endif /* not NEW_GC */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
504
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
505 #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
506 static struct
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
507 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
508 int instances_in_use;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
509 int bytes_in_use;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
510 int bytes_in_use_including_overhead;
3461
fd2936bbfc5f [xemacs-hg @ 2006-06-19 18:10:17 by james]
james
parents: 3355
diff changeset
511 } lrecord_stats [countof (lrecord_implementations_table)];
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
512
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
513 void
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
514 init_lrecord_stats ()
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
515 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
516 xzero (lrecord_stats);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
517 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
518
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
519 void
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
520 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
521 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
522 int type_index = h->type;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
523 if (!size)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
524 size = detagged_lisp_object_size (h);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
525
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
526 lrecord_stats[type_index].instances_in_use++;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
527 lrecord_stats[type_index].bytes_in_use += size;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
528 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
529 #ifdef MEMORY_USAGE_STATS
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
530 += mc_alloced_storage_size (size, 0);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
531 #else /* not MEMORY_USAGE_STATS */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
532 += size;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
533 #endif /* not MEMORY_USAGE_STATS */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
534 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
535
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
536 void
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
537 dec_lrecord_stats (Bytecount size_including_overhead,
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
538 const struct lrecord_header *h)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
539 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
540 int type_index = h->type;
2775
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani]
crestani
parents: 2720
diff changeset
541 int size = detagged_lisp_object_size (h);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
542
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
543 lrecord_stats[type_index].instances_in_use--;
2775
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani]
crestani
parents: 2720
diff changeset
544 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
545 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
546 -= size_including_overhead;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
547
2775
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani]
crestani
parents: 2720
diff changeset
548 DECREMENT_CONS_COUNTER (size);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
549 }
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
550
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
551 int
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
552 lrecord_stats_heap_size (void)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
553 {
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
554 int i;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
555 int size = 0;
3461
fd2936bbfc5f [xemacs-hg @ 2006-06-19 18:10:17 by james]
james
parents: 3355
diff changeset
556 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
557 size += lrecord_stats[i].bytes_in_use;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
558 return size;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
559 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
560 #endif /* NEW_GC && ALLOC_TYPE_STATS */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
561
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
562 #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
563 type_checking_assert \
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
564 (implementation->static_size == 0 ? \
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
565 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
566 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
567 implementation->static_size == size)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
568
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
569 #ifndef NEW_GC
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
570 /* lcrecords are chained together through their "next" field.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
571 After doing the mark phase, GC will walk this linked list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
572 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
573 static struct old_lcrecord_header *all_lcrecords;
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
574 #endif /* not NEW_GC */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
575
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
576 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
577 /* 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
578 static Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
579 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
580 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
581 int noseeum)
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
582 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
583 struct lrecord_header *lheader;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
584
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
585 assert_proper_sizing (size);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
586
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
587 lheader = (struct lrecord_header *) mc_alloc (size);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
588 gc_checking_assert (LRECORD_FREE_P (lheader));
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
589 set_lheader_implementation (lheader, implementation);
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
590 #ifdef ALLOC_TYPE_STATS
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
591 inc_lrecord_stats (size, lheader);
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
592 #endif /* ALLOC_TYPE_STATS */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
593 if (implementation->finalizer)
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
594 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
595 if (noseeum)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
596 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
597 else
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
598 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
599 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
600 }
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
601
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
602 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
603 alloc_sized_lrecord (Bytecount size,
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
604 const struct lrecord_implementation *implementation)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
605 {
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
606 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
607 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
608
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
609 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
610 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
611 const struct lrecord_implementation *
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
612 implementation)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
613 {
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
614 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
615 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
616
5117
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_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
619 {
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
620 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
621 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
622 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
623
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
624 Lisp_Object
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
625 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
626 {
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
627 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
628 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
629 }
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
630
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
631 Lisp_Object
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
632 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
633 const struct lrecord_implementation *implementation)
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
634 {
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
635 struct lrecord_header *lheader;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
636 Rawbyte *start, *stop;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
637
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
638 assert_proper_sizing (size);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
639
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
640 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
641 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
642
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
643 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
644 /* #### 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
645 stop = ((Rawbyte *) lheader) + (size * elemcount -1);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
646 start < stop; start += size)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
647 {
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
648 struct lrecord_header *lh = (struct lrecord_header *) start;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
649 set_lheader_implementation (lh, implementation);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
650 #ifdef ALLOC_TYPE_STATS
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
651 inc_lrecord_stats (size, lh);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
652 #endif /* not ALLOC_TYPE_STATS */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
653 if (implementation->finalizer)
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
654 add_finalizable_obj (wrap_pointer_1 (lh));
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
655 }
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
656
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
657 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
658 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
659 }
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
660
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
661 Lisp_Object
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
662 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
663 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
664 {
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
665 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
666 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
667 implementation);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
668 }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
669
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
670 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
672 /* 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
673 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
674 specified size. See lrecord.h. */
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
675
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
676 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
677 old_alloc_sized_lcrecord (Bytecount size,
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
678 const struct lrecord_implementation *implementation)
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
679 {
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
680 struct old_lcrecord_header *lcheader;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
682 assert_proper_sizing (size);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
683 type_checking_assert
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
684 (!implementation->frob_block_p
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
685 &&
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
686 !(implementation->hash == NULL && implementation->equal != NULL));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
688 lcheader = (struct old_lcrecord_header *) allocate_lisp_storage (size);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
689 set_lheader_implementation (&lcheader->lheader, implementation);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 lcheader->next = all_lcrecords;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 all_lcrecords = lcheader;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 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
693 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
694 }
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
695
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
696 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
697 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
698 {
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
699 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
700 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
701 implementation);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 #if 0 /* Presently unused */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 /* Very, very poor man's EGC?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 * This may be slow and thrash pages all over the place.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 * Only call it if you really feel you must (and if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 * lrecord was fairly recently allocated).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 * 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
710 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 void
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
712 very_old_free_lcrecord (struct old_lcrecord_header *lcrecord)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 if (all_lcrecords == lcrecord)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 all_lcrecords = lcrecord->next;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 {
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
720 struct old_lcrecord_header *header = all_lcrecords;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 {
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
723 struct old_lcrecord_header *next = header->next;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 if (next == lcrecord)
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 header->next = lrecord->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 break;
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 else if (next == 0)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
730 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 header = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 if (lrecord->implementation->finalizer)
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
736 lrecord->implementation->finalizer (wrap_pointer_1 (lrecord));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 xfree (lrecord);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 #endif /* Unused */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
741 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 disksave_object_finalization_1 (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 {
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
747 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
748 mc_finalize_for_disksave ();
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
749 #else /* not NEW_GC */
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
750 struct old_lcrecord_header *header;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 for (header = all_lcrecords; header; header = header->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 {
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
754 struct lrecord_header *objh = &header->lheader;
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
755 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
756 #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
757 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
758 {
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
759 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
760 debug_print (wrap_pointer_1 (header));
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
761 }
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
762 #endif
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5127
diff changeset
763 if (imp->disksaver && !objh->free)
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
764 (imp->disksaver) (wrap_pointer_1 (header));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
766 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
769 /* 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
770
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
771 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
772 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
773 {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
774 const struct lrecord_implementation *imp =
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
775 XRECORD_LHEADER_IMPLEMENTATION (src);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
776 Bytecount size = lisp_object_size (src);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
777
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
778 assert (imp == XRECORD_LHEADER_IMPLEMENTATION (dst));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
779 assert (size == lisp_object_size (dst));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
780
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
781 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
782 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
783 (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
784 size - sizeof (struct lrecord_header));
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
785 #else /* not NEW_GC */
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
786 if (imp->frob_block_p)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
787 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
788 (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header),
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
789 size - sizeof (struct lrecord_header));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
790 else
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
791 memcpy ((char *) XRECORD_LHEADER (dst) +
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
792 sizeof (struct old_lcrecord_header),
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
793 (char *) XRECORD_LHEADER (src) +
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
794 sizeof (struct old_lcrecord_header),
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
795 size - sizeof (struct old_lcrecord_header));
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
796 #endif /* not NEW_GC */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
797 }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
798
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
799 /* 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
800 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
801 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
802 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
803 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
804
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
805 void
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
806 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
807 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
808 #ifndef NEW_GC
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
809 const struct lrecord_implementation *imp =
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
810 XRECORD_LHEADER_IMPLEMENTATION (obj);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
811 #endif /* not NEW_GC */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
812
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
813 #ifdef NEW_GC
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
814 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
815 size - sizeof (struct lrecord_header));
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
816 #else /* not NEW_GC */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
817 if (imp->frob_block_p)
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
818 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
819 size - sizeof (struct lrecord_header));
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
820 else
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
821 memset ((char *) XRECORD_LHEADER (obj) +
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
822 sizeof (struct old_lcrecord_header), 0,
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
823 size - sizeof (struct old_lcrecord_header));
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
824 #endif /* not NEW_GC */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
825 }
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
826
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
827 /* 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
828 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
829 zero_sized_lisp_object().
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
830 */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
831
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
832 void
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
833 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
834 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
835 const struct lrecord_implementation *imp =
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
836 XRECORD_LHEADER_IMPLEMENTATION (obj);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
837 assert (!imp->size_in_bytes_method);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
838
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
839 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
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 #ifdef MEMORY_USAGE_STATS
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
843
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
844 Bytecount
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
845 lisp_object_storage_size (Lisp_Object obj, struct overhead_stats *ovstats)
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 #ifndef NEW_GC
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
848 const struct lrecord_implementation *imp =
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
849 XRECORD_LHEADER_IMPLEMENTATION (obj);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
850 #endif /* not NEW_GC */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
851 Bytecount size = lisp_object_size (obj);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
852
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
853 #ifdef NEW_GC
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
854 return mc_alloced_storage_size (size, ovstats);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
855 #else
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
856 if (imp->frob_block_p)
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
857 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
858 Bytecount overhead = fixed_type_block_overhead (size);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
859 if (ovstats)
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
860 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
861 ovstats->was_requested += size;
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
862 ovstats->malloc_overhead += overhead;
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
863 }
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
864 return size + overhead;
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
865 }
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
866 else
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
867 return malloced_storage_size (XPNTR (obj), size, ovstats);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
868 #endif
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
869 }
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
870
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
871 #endif /* MEMORY_USAGE_STATS */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
872
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
873 void
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
874 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
875 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
876 #ifndef NEW_GC
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
877 const struct lrecord_implementation *imp =
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
878 XRECORD_LHEADER_IMPLEMENTATION (obj);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
879 #endif /* not NEW_GC */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
880
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
881 #ifdef NEW_GC
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
882 /* 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
883 return;
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
884 #else
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
885 assert (!imp->frob_block_p);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
886 assert (!imp->size_in_bytes_method);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
887 old_free_lcrecord (obj);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
888 #endif
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
889 }
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
890
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 /* Debugger support */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 /* Give gdb/dbx enough information to decode Lisp Objects. We make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 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
897 about expressions in src/.gdbinit. See src/.gdbinit or src/.dbxrc
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
898 to see how this is used. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
900 EMACS_UINT dbg_valmask = ((1UL << VALBITS) - 1) << GCBITS;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
901 EMACS_UINT dbg_typemask = (1UL << GCTYPEBITS) - 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 #ifdef USE_UNION_TYPE
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
904 unsigned char dbg_USE_UNION_TYPE = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 #else
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
906 unsigned char dbg_USE_UNION_TYPE = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
909 unsigned char dbg_valbits = VALBITS;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
910 unsigned char dbg_gctypebits = GCTYPEBITS;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
911
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
912 /* On some systems, the above definitions will be optimized away by
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
913 the compiler or linker unless they are referenced in some function. */
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
914 long dbg_inhibit_dbg_symbol_deletion (void);
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
915 long
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
916 dbg_inhibit_dbg_symbol_deletion (void)
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
917 {
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
918 return
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
919 (dbg_valmask +
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
920 dbg_typemask +
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
921 dbg_USE_UNION_TYPE +
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
922 dbg_valbits +
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
923 dbg_gctypebits);
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
924 }
428
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 /* Macros turned into functions for ease of debugging.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 Debuggers don't know about macros! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 int dbg_eq (Lisp_Object obj1, Lisp_Object obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 dbg_eq (Lisp_Object obj1, Lisp_Object obj2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 return EQ (obj1, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
936 #ifdef NEW_GC
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
937 #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
938 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 /* Fixed-size type macros */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 /************************************************************************/
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 /* For fixed-size types that are commonly used, we malloc() large blocks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 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
945 size for an object of that type. This is more efficient than
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 malloc()ing each object separately because we save on malloc() time
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 and overhead due to the fewer number of malloc()ed blocks, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 also because we don't need any extra pointers within each object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 to keep them threaded together for GC purposes. For less common
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 (and frequently large-size) types, we use lcrecords, which are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 malloc()ed individually and chained together through a pointer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 in the lcrecord header. lcrecords do not need to be fixed-size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 (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
954 however, the size of a particular object cannot vary dynamically).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 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
956 additional code needs to be added to alloc.c. Finally, lcrecords
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 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
958
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 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
960 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
961 marker, extent, event, and string.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 Note that strings are special in that they are actually stored in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 two parts: a structure containing information about the string, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 the actual data associated with the string. The former structure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 (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
967 same way as all the other such types. This structure contains a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 pointer to the actual string data, which is stored in structures of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 type struct string_chars_block. Each string_chars_block consists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 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
971 string, followed by another pointer to a Lisp_String, followed by
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
972 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
973 blocks is compacted by searching sequentially through all the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 blocks and compressing out any holes created by unmarked strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 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
976 a string_chars_block, although something like half as big might
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 make more sense) are malloc()ed separately and not stored in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 string_chars_blocks. Furthermore, no one string stretches across
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 two string_chars_blocks.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
981 Vectors are each malloc()ed separately as lcrecords.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 In the following discussion, we use conses, but it applies equally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 well to the other fixed-size types.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 We store cons cells inside of cons_blocks, allocating a new
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 cons_block with malloc() whenever necessary. Cons cells reclaimed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 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
989 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
990 just under 2^n - MALLOC_OVERHEAD bytes long, since malloc (at least
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 the versions in malloc.c and gmalloc.c) really allocates in units
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 of powers of two and uses 4 bytes for its own overhead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 What GC actually does is to search through all the cons_blocks,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 from the most recently allocated to the oldest, and put all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 cons cells that are not marked (whether or not they're already
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 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
998 so the cons cells in the oldest-allocated cons_block end up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 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
1000 If any cons_block is entirely free, it is freed with free()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 and its cons cells removed from the cons_free_list. Because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 the cons_free_list ends up basically in memory order, we have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 a high locality of reference (assuming a reasonable turnover
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 of allocating and freeing) and have a reasonable probability
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 of entirely freeing up cons_blocks that have been more recently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 allocated. This stage is called the "sweep stage" of GC, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 is executed after the "mark stage", which involves starting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 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
1009 (e.g. the obarray, where are all symbols are stored; the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 current catches and condition-cases; the backtrace list of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 currently executing functions; the gcpro list; etc.) and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 recursively marking all objects that are accessible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1014 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
1015 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
1016 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
1017 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
1018 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
1019 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
1020 macro. This uses a special lrecord type `lrecord_type_free',
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1021 which is never associated with any valid object.
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1022
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1023 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
1024 in the conses themselves. Because the cons is still in a
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1025 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
1026 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
1027 indicator and the chaining pointer. So this pointer is stored
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1028 after the lrecord header (actually where C places a pointer after
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1029 the lrecord header; they are not necessarily contiguous). This
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1030 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
1031 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
1032 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
1033 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
1034 ensure adequate space for the free list chain pointer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 Some types of objects need additional "finalization" done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 when an object is converted from in use to not in use;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 this is the purpose of the ADDITIONAL_FREE_type macro.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 For example, markers need to be removed from the chain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 of markers that is kept in each buffer. This is because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 markers in a buffer automatically disappear if the marker
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 is no longer referenced anywhere (the same does not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 apply to extents, however).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 WARNING: Things are in an extremely bizarre state when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 the ADDITIONAL_FREE_type macros are called, so beware!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1048 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
1049 maximize our chances of catching places where there is insufficient
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1050 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
1051 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
1052 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
1053 something seemingly unrelated getting trashed, and is extremely
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1054 difficult to track down. If the object gets freed but not
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1055 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
1056 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
1057 to the invalid type `lrecord_type_free', however, and a pointer
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1058 used to chain freed objects together is stored after the lrecord
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1059 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
1060 bogus, so crashes are more likely to occur right away.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 We want freed objects to stay free as long as possible,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 so instead of doing what we do above, we maintain the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 free objects in a first-in first-out queue. We also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 don't recompute the free list each GC, unlike above;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 this ensures that the queue ordering is preserved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 [This means that we are likely to have worse locality
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 of reference, and that we can never free a frob block
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 once it's allocated. (Even if we know that all cells
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 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
1071 cells from the free list because the objects on the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 free list are unlikely to be in memory order.)]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 Furthermore, we never take objects off the free list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 unless there's a large number (usually 1000, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 varies depending on type) of them already on the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 This way, we ensure that an object that gets freed will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 remain free for the next 1000 (or whatever) times that
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1078 an object of that type is allocated. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 #if !defined(HAVE_MMAP) || defined(DOUG_LEA_MALLOC)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 /* If we released our reserve (due to running out of memory),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 and we have a fair amount free once again,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 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
1084
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 This is called when a relocatable block is freed in ralloc.c. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 void refill_memory_reserve (void);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1088 refill_memory_reserve (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 if (breathing_space == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 breathing_space = (char *) malloc (4096 - MALLOC_OVERHEAD);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 #endif
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 #ifdef ALLOC_NO_POOLS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 # define TYPE_ALLOC_SIZE(type, structtype) 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 # define TYPE_ALLOC_SIZE(type, structtype) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 ((2048 - MALLOC_OVERHEAD - sizeof (struct type##_block *)) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 / sizeof (structtype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 #endif /* ALLOC_NO_POOLS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 #define DECLARE_FIXED_TYPE_ALLOC(type, structtype) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 struct type##_block \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 struct type##_block *prev; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 structtype block[TYPE_ALLOC_SIZE (type, structtype)]; \
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 struct type##_block *current_##type##_block; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 static int current_##type##_block_index; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1114 static Lisp_Free *type##_free_list; \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1115 static Lisp_Free *type##_free_list_tail; \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 static void \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 init_##type##_alloc (void) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 current_##type##_block = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 current_##type##_block_index = \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 countof (current_##type##_block->block); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 type##_free_list = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 type##_free_list_tail = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 static int gc_count_num_##type##_in_use; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 static int gc_count_num_##type##_freelist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 #define ALLOCATE_FIXED_TYPE_FROM_BLOCK(type, result) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 if (current_##type##_block_index \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 == countof (current_##type##_block->block)) \
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 struct type##_block *AFTFB_new = (struct type##_block *) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 allocate_lisp_storage (sizeof (struct type##_block)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 AFTFB_new->prev = current_##type##_block; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 current_##type##_block = AFTFB_new; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 current_##type##_block_index = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 (result) = \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 &(current_##type##_block->block[current_##type##_block_index++]); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 /* Allocate an instance of a type that is stored in blocks.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 TYPE is the "name" of the type, STRUCTTYPE is the corresponding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 structure type. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 #ifdef ERROR_CHECK_GC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 /* Note: if you get crashes in this function, suspect incorrect calls
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 to free_cons() and friends. This happened once because the cons
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 cell was not GC-protected and was getting collected before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 free_cons() was called. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1155 #define ALLOCATE_FIXED_TYPE_1(type, structtype, result) do { \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1156 if (gc_count_num_##type##_freelist > \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1157 MINIMUM_ALLOWED_FIXED_TYPE_CELLS_##type) \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1158 { \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1159 result = (structtype *) type##_free_list; \
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1160 assert (LRECORD_FREE_P (result)); \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1161 /* Before actually using the chain pointer, we complement \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1162 all its bits; see PUT_FIXED_TYPE_ON_FREE_LIST(). */ \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1163 type##_free_list = (Lisp_Free *) \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1164 (~ (EMACS_UINT) (type##_free_list->chain)); \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1165 gc_count_num_##type##_freelist--; \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1166 } \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1167 else \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1168 ALLOCATE_FIXED_TYPE_FROM_BLOCK (type, result); \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1169 MARK_LRECORD_AS_NOT_FREE (result); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 #else /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1174 #define ALLOCATE_FIXED_TYPE_1(type, structtype, result) do { \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 if (type##_free_list) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 { \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1177 result = (structtype *) type##_free_list; \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1178 type##_free_list = type##_free_list->chain; \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 ALLOCATE_FIXED_TYPE_FROM_BLOCK (type, result); \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1182 MARK_LRECORD_AS_NOT_FREE (result); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 #endif /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1187
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 #define ALLOCATE_FIXED_TYPE(type, structtype, result) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 do \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 ALLOCATE_FIXED_TYPE_1 (type, structtype, result); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 INCREMENT_CONS_COUNTER (sizeof (structtype), #type); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 #define NOSEEUM_ALLOCATE_FIXED_TYPE(type, structtype, result) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 do \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 ALLOCATE_FIXED_TYPE_1 (type, structtype, result); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 NOSEEUM_INCREMENT_CONS_COUNTER (sizeof (structtype), #type); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1202 /* 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
1203 block of any lisp object type. */
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1204 typedef struct Lisp_Free
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1205 {
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1206 struct lrecord_header lheader;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1207 struct Lisp_Free *chain;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1208 } Lisp_Free;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1209
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1210 #define LRECORD_FREE_P(ptr) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1211 (((struct lrecord_header *) ptr)->type == lrecord_type_free)
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1212
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1213 #define MARK_LRECORD_AS_FREE(ptr) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1214 ((void) (((struct lrecord_header *) ptr)->type = lrecord_type_free))
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1215
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1216 #ifdef ERROR_CHECK_GC
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1217 #define MARK_LRECORD_AS_NOT_FREE(ptr) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1218 ((void) (((struct lrecord_header *) ptr)->type = lrecord_type_undefined))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 #else
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1220 #define MARK_LRECORD_AS_NOT_FREE(ptr) DO_NOTHING
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 #ifdef ERROR_CHECK_GC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1225 #define PUT_FIXED_TYPE_ON_FREE_LIST(type, structtype, ptr) do { \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1226 if (type##_free_list_tail) \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1227 { \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1228 /* When we store the chain pointer, we complement all \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1229 its bits; this should significantly increase its \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1230 bogosity in case someone tries to use the value, and \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1231 should make us crash faster if someone overwrites the \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1232 pointer because when it gets un-complemented in \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1233 ALLOCATED_FIXED_TYPE(), the resulting pointer will be \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1234 extremely bogus. */ \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1235 type##_free_list_tail->chain = \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1236 (Lisp_Free *) ~ (EMACS_UINT) (ptr); \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1237 } \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1238 else \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1239 type##_free_list = (Lisp_Free *) (ptr); \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1240 type##_free_list_tail = (Lisp_Free *) (ptr); \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1241 } while (0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 #else /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1245 #define PUT_FIXED_TYPE_ON_FREE_LIST(type, structtype, ptr) do { \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1246 ((Lisp_Free *) (ptr))->chain = type##_free_list; \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1247 type##_free_list = (Lisp_Free *) (ptr); \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1248 } while (0) \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 #endif /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 /* TYPE and STRUCTTYPE are the same as in ALLOCATE_FIXED_TYPE(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 #define FREE_FIXED_TYPE(type, structtype, ptr) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 structtype *FFT_ptr = (ptr); \
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1256 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
1257 gc_checking_assert (!DUMPEDP (FFT_ptr)); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 ADDITIONAL_FREE_##type (FFT_ptr); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 deadbeef_memory (FFT_ptr, sizeof (structtype)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 PUT_FIXED_TYPE_ON_FREE_LIST (type, structtype, FFT_ptr); \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
1261 MARK_LRECORD_AS_FREE (FFT_ptr); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 } while (0)
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1263 #endif /* NEW_GC */
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1264
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1265 #ifdef NEW_GC
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1266 #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
1267 free_normal_lisp_object (lo)
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1268 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 /* Like FREE_FIXED_TYPE() but used when we are explicitly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 freeing a structure through free_cons(), free_marker(), etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 rather than through the normal process of sweeping.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 We attempt to undo the changes made to the allocation counters
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 as a result of this structure being allocated. This is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 completely necessary but helps keep things saner: e.g. this way,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 repeatedly allocating and freeing a cons will not result in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 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
1277 and somewhat defeat the purpose of explicitly freeing.
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1278
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1279 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
1280 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
1281
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1282 #ifndef ALLOC_NO_POOLS
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1283 #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
1284 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
1285 DECREMENT_CONS_COUNTER (sizeof (structtype)); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1286 gc_count_num_##type##_freelist++; \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 } while (0)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1288 #else
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1289 #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
1290 #endif
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
1291 #endif /* (not) NEW_GC */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
1292
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
1293 #ifdef NEW_GC
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1294 #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
1295 do { \
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1296 (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
1297 } while (0)
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1298 #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
1299 lrec_ptr) \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1300 do { \
5120
d1247f3cc363 latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents: 5118
diff changeset
1301 (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
1302 } while (0)
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
1303 #else /* not NEW_GC */
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1304 #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
1305 do \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1306 { \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1307 ALLOCATE_FIXED_TYPE (type, lisp_type, var); \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1308 set_lheader_implementation (&(var)->lheader, lrec_ptr); \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1309 } while (0)
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1310 #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
1311 lrec_ptr) \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1312 do \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1313 { \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1314 NOSEEUM_ALLOCATE_FIXED_TYPE (type, lisp_type, var); \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1315 set_lheader_implementation (&(var)->lheader, lrec_ptr); \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1316 } while (0)
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
1317 #endif /* not NEW_GC */
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1318
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 /* Cons allocation */
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
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1325 DECLARE_FIXED_TYPE_ALLOC (cons, Lisp_Cons);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 /* 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
1327 /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 20000 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 2000
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 mark_cons (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 if (NILP (XCDR (obj)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 return XCAR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 mark_object (XCAR (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 return XCDR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 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
1341 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
1342 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1343 depth++;
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
1344 while (internal_equal_0 (XCAR (ob1), XCAR (ob2), depth, foldcase))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 ob1 = XCDR (ob1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 ob2 = XCDR (ob2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 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
1349 return internal_equal_0 (ob1, ob2, depth, foldcase);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 return 0;
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
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1354 static const struct memory_description cons_description[] = {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1355 { XD_LISP_OBJECT, offsetof (Lisp_Cons, car_) },
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1356 { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr_) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1360 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
1361 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
1362 /*
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1363 * 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
1364 * 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
1365 * handle conses.
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1366 */
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1367 0, cons_description, Lisp_Cons);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 DEFUN ("cons", Fcons, 2, 2, 0, /*
3355
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3305
diff changeset
1370 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
1371
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3305
diff changeset
1372 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
1373 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
1374 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
1375 series of cons cells.
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3305
diff changeset
1376
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan]
aidan
parents: 3305
diff changeset
1377 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
1378 `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
1379 `rplaca' and `rplacd' (for `setcar' and `setcdr') are supported.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 (car, cdr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 /* This cannot GC. */
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 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);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1389 XSETCAR (val, car);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1390 XSETCDR (val, cdr);
428
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 /* 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
1395 going to free later, and is useful when trying to track down
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 "real" consing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 noseeum_cons (Lisp_Object car, Lisp_Object cdr)
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 Lisp_Object val;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1401 Lisp_Cons *c;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1402
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1403 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
1404 val = wrap_cons (c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 XCAR (val) = car;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 XCDR (val) = cdr;
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 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
1411 Return a newly created list with specified ARGS as elements.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 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
1413
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
1414 arguments: (&rest ARGS)
428
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 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 Lisp_Object val = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 Lisp_Object *argp = args + nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 while (argp > args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 val = Fcons (*--argp, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 list1 (Lisp_Object obj0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 return Fcons (obj0, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 list2 (Lisp_Object obj0, Lisp_Object obj1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 return Fcons (obj0, Fcons (obj1, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 list3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2)
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 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 return Fcons (obj0, Fcons (obj1, Fcons (obj2, Qnil)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 }
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 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 cons3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2)
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 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 return Fcons (obj0, Fcons (obj1, obj2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 acons (Lisp_Object key, Lisp_Object value, Lisp_Object alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 return Fcons (Fcons (key, value), alist);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 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
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, 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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 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
1469 Lisp_Object obj4)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Fcons (obj4, Qnil)))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 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
1477 Lisp_Object obj4, Lisp_Object obj5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 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
1481 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 DEFUN ("make-list", Fmake_list, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1484 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
1485 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1486 (length, object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 CHECK_NATNUM (length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 Lisp_Object val = Qnil;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 617
diff changeset
1492 EMACS_INT size = XINT (length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 while (size--)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1495 val = Fcons (object, val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 /* Float allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1505 /*** With enhanced number support, these are short floats */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1506
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1507 DECLARE_FIXED_TYPE_ALLOC (float, Lisp_Float);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_float 1000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 make_float (double float_value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1513 Lisp_Float *f;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1514
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1515 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
1516
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1517 /* Avoid dump-time `uninitialized memory read' purify warnings. */
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1518 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
1519 zero_nonsized_lisp_object (wrap_float (f));
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2994
diff changeset
1520
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 float_data (f) = float_value;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1522 return wrap_float (f);
428
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 /************************************************************************/
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1527 /* Enhanced number allocation */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1528 /************************************************************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1529
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1530 /*** Bignum ***/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1531 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1532 DECLARE_FIXED_TYPE_ALLOC (bignum, Lisp_Bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1533 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_bignum 250
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1534
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1535 /* 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
1536 fixnum. See Fcanonicalize_number(). */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1537 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1538 make_bignum (long bignum_value)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1539 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1540 Lisp_Bignum *b;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1541
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1542 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
1543 bignum_init (bignum_data (b));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1544 bignum_set_long (bignum_data (b), bignum_value);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1545 return wrap_bignum (b);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1546 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1547
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1548 /* 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
1549 fixnum. See Fcanonicalize_number(). */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1550 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1551 make_bignum_bg (bignum bg)
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 Lisp_Bignum *b;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1554
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1555 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
1556 bignum_init (bignum_data (b));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1557 bignum_set (bignum_data (b), bg);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1558 return wrap_bignum (b);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1559 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1560 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1561
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1562 /*** Ratio ***/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1563 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1564 DECLARE_FIXED_TYPE_ALLOC (ratio, Lisp_Ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1565 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_ratio 250
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1566
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1567 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1568 make_ratio (long numerator, unsigned long denominator)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1569 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1570 Lisp_Ratio *r;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1571
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1572 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
1573 ratio_init (ratio_data (r));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1574 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
1575 ratio_canonicalize (ratio_data (r));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1576 return wrap_ratio (r);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1577 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1578
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1579 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1580 make_ratio_bg (bignum numerator, bignum denominator)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1581 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1582 Lisp_Ratio *r;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1583
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1584 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
1585 ratio_init (ratio_data (r));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1586 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
1587 ratio_canonicalize (ratio_data (r));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1588 return wrap_ratio (r);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1589 }
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_rt (ratio rat)
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 (ratio_data (r), rat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1599 return wrap_ratio (r);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1600 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1601 #endif /* HAVE_RATIO */
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 /*** Bigfloat ***/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1604 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1605 DECLARE_FIXED_TYPE_ALLOC (bigfloat, Lisp_Bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1606 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_bigfloat 250
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1607
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1608 /* 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
1609 PRECISION argument is zero. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1610 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1611 make_bigfloat (double float_value, unsigned long precision)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1612 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1613 Lisp_Bigfloat *f;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1614
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1615 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
1616 if (precision == 0UL)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1617 bigfloat_init (bigfloat_data (f));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1618 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1619 bigfloat_init_prec (bigfloat_data (f), precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1620 bigfloat_set_double (bigfloat_data (f), float_value);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1621 return wrap_bigfloat (f);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1622 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1623
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1624 /* 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
1625 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1626 make_bigfloat_bf (bigfloat float_value)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1627 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1628 Lisp_Bigfloat *f;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1629
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1630 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
1631 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
1632 bigfloat_set (bigfloat_data (f), float_value);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1633 return wrap_bigfloat (f);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1634 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
1635 #endif /* HAVE_BIGFLOAT */
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 /************************************************************************/
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 /* Vector allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 mark_vector (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 Lisp_Vector *ptr = XVECTOR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 int len = vector_length (ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 for (i = 0; i < len - 1; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 mark_object (ptr->contents[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 return (len > 0) ? ptr->contents[len - 1] : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1653 static Bytecount
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1654 size_vector (Lisp_Object obj)
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1655 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1656
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 454
diff changeset
1657 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
1658 XVECTOR (obj)->size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 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
1662 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
1663 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 int len = XVECTOR_LENGTH (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 if (len != XVECTOR_LENGTH (obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 return 0;
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 Lisp_Object *ptr1 = XVECTOR_DATA (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 Lisp_Object *ptr2 = XVECTOR_DATA (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 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
1672 if (!internal_equal_0 (*ptr1++, *ptr2++, depth + 1, foldcase))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1678 static Hashcode
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1679 vector_hash (Lisp_Object obj, int depth)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1680 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1681 return HASH2 (XVECTOR_LENGTH (obj),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1682 internal_array_hash (XVECTOR_DATA (obj),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1683 XVECTOR_LENGTH (obj),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1684 depth + 1));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1685 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1686
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1687 static const struct memory_description vector_description[] = {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1688 { XD_LONG, offsetof (Lisp_Vector, size) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1689 { 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
1690 { XD_END }
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
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1693 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
1694 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
1695 vector_equal,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1696 vector_hash,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1697 vector_description,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
1698 size_vector, Lisp_Vector);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 /* #### should allocate `small' vectors from a frob-block */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 static Lisp_Vector *
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1701 make_vector_internal (Elemcount sizei)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1703 /* no `next' field; we use lcrecords */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1704 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
1705 contents, sizei);
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
1706 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
1707 Lisp_Vector *p = XVECTOR (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 p->size = sizei;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 return p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 Lisp_Object
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1714 make_vector (Elemcount length, Lisp_Object object)
428
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 Lisp_Vector *vecp = make_vector_internal (length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 Lisp_Object *p = vector_data (vecp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 while (length--)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1720 *p++ = object;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1722 return wrap_vector (vecp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 DEFUN ("make-vector", Fmake_vector, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1726 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
1727 See also the function `vector'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1729 (length, object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 CONCHECK_NATNUM (length);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1732 return make_vector (XINT (length), object);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 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
1736 Return a newly created vector with specified ARGS as elements.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 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
1738
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
1739 arguments: (&rest ARGS)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 (int nargs, Lisp_Object *args))
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 Lisp_Vector *vecp = make_vector_internal (nargs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 Lisp_Object *p = vector_data (vecp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 while (nargs--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 *p++ = *args++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1749 return wrap_vector (vecp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 vector1 (Lisp_Object obj0)
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 return Fvector (1, &obj0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 }
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 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 vector2 (Lisp_Object obj0, Lisp_Object obj1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 Lisp_Object args[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 return Fvector (2, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 }
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_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 vector3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2)
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 Lisp_Object args[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 return Fvector (3, args);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 #if 0 /* currently unused */
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 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 vector4 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 Lisp_Object obj3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 Lisp_Object args[4];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 return Fvector (4, 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 vector5 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 Lisp_Object obj3, Lisp_Object obj4)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 Lisp_Object args[5];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 args[4] = obj4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 return Fvector (5, args);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 vector6 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 Lisp_Object args[6];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 args[4] = obj4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 args[5] = obj5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 return Fvector (6, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 vector7 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 Lisp_Object obj6)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 Lisp_Object args[7];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 args[4] = obj4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 args[5] = obj5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 args[6] = obj6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 return Fvector (7, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 vector8 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 Lisp_Object obj6, Lisp_Object obj7)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 Lisp_Object args[8];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 args[4] = obj4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 args[5] = obj5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 args[6] = obj6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 args[7] = obj7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 return Fvector (8, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 #endif /* unused */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 /* Bit Vector allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 /* #### should allocate `small' bit vectors from a frob-block */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1857 static Lisp_Bit_Vector *
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1858 make_bit_vector_internal (Elemcount sizei)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1860 /* no `next' field; we use lcrecords */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1861 Elemcount num_longs = BIT_VECTOR_LONG_STORAGE (sizei);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1862 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
1863 unsigned long,
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
1864 bits, num_longs);
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
1865 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
1866 Lisp_Bit_Vector *p = XBIT_VECTOR (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 bit_vector_length (p) = sizei;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 return p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 Lisp_Object
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1873 make_bit_vector (Elemcount length, Lisp_Object bit)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1875 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
1876 Elemcount num_longs = BIT_VECTOR_LONG_STORAGE (length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1878 CHECK_BIT (bit);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1879
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1880 if (ZEROP (bit))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 memset (p->bits, 0, num_longs * sizeof (long));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1884 Elemcount bits_in_last = length & (LONGBITS_POWER_OF_2 - 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 memset (p->bits, ~0, num_longs * sizeof (long));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 /* But we have to make sure that the unused bits in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 last long are 0, so that equal/hash is easy. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 if (bits_in_last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 p->bits[num_longs - 1] &= (1 << bits_in_last) - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1892 return wrap_bit_vector (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 }
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 Lisp_Object
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1896 make_bit_vector_from_byte_vector (unsigned char *bytevec, Elemcount length)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1898 Elemcount i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 Lisp_Bit_Vector *p = make_bit_vector_internal (length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 for (i = 0; i < length; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 set_bit_vector_bit (p, i, bytevec[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1904 return wrap_bit_vector (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 DEFUN ("make-bit-vector", Fmake_bit_vector, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1908 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
1909 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
1910 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1911 (length, bit))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 CONCHECK_NATNUM (length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1915 return make_bit_vector (XINT (length), bit);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 }
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 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
1919 Return a newly created bit vector with specified ARGS as elements.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 Any number of arguments, even zero arguments, are allowed.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1921 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
1922
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
1923 arguments: (&rest ARGS)
428
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 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 Lisp_Bit_Vector *p = make_bit_vector_internal (nargs);
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 for (i = 0; i < nargs; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 CHECK_BIT (args[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 set_bit_vector_bit (p, i, !ZEROP (args[i]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1936 return wrap_bit_vector (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939
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 /* Compiled-function allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 DECLARE_FIXED_TYPE_ALLOC (compiled_function, Lisp_Compiled_Function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_compiled_function 1000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 make_compiled_function (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 Lisp_Compiled_Function *f;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
1952 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
1953 f, &lrecord_compiled_function);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 f->stack_depth = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 f->specpdl_depth = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 f->flags.documentationp = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 f->flags.interactivep = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 f->flags.domainp = 0; /* I18N3 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 f->instructions = Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 f->constants = Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 f->arglist = Qnil;
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
1963 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
1964 f->arguments = Qnil;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
1965 #else /* not NEW_GC */
1739
9ddedfc70c4a [xemacs-hg @ 2003-10-10 18:04:23 by james]
james
parents: 1737
diff changeset
1966 f->args = NULL;
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
1967 #endif /* not NEW_GC */
1739
9ddedfc70c4a [xemacs-hg @ 2003-10-10 18:04:23 by james]
james
parents: 1737
diff changeset
1968 f->max_args = f->min_args = f->args_in_array = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 f->doc_and_interactive = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 f->annotated = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 #endif
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
1973 return wrap_compiled_function (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 DEFUN ("make-byte-code", Fmake_byte_code, 4, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 Return a new compiled-function object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 Note that, unlike all other emacs-lisp functions, calling this with five
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 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
1980 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
1981 that this function was defined with `(interactive)'. If the arg is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 specified, then that means the function is not interactive.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 This is terrible behavior which is retained for compatibility with old
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 `.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
1985
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
1986 arguments: (ARGLIST INSTRUCTIONS CONSTANTS STACK-DEPTH &optional DOC-STRING INTERACTIVE)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 /* In a non-insane world this function would have this arglist...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 (arglist instructions constants stack_depth &optional doc_string interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 Lisp_Object fun = make_compiled_function ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 Lisp_Object arglist = args[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 Lisp_Object instructions = args[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 Lisp_Object constants = args[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 Lisp_Object stack_depth = args[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 Lisp_Object doc_string = (nargs > 4) ? args[4] : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 Lisp_Object interactive = (nargs > 5) ? args[5] : Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 if (nargs < 4 || nargs > 6)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 return Fsignal (Qwrong_number_of_arguments,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 list2 (intern ("make-byte-code"), make_int (nargs)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 /* Check for valid formal parameter list now, to allow us to use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 SPECBIND_FAST_UNSAFE() later in funcall_compiled_function(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 {
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2010 EXTERNAL_LIST_LOOP_2 (symbol, arglist)
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 CHECK_SYMBOL (symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 if (EQ (symbol, Qt) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 EQ (symbol, Qnil) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 SYMBOL_IS_KEYWORD (symbol))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 551
diff changeset
2016 invalid_constant_2
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 ("Invalid constant symbol in formal parameter list",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 symbol, arglist);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 f->arglist = arglist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 /* `instructions' is a string or a cons (string . int) for a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 lazy-loaded function. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 if (CONSP (instructions))
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 CHECK_STRING (XCAR (instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 CHECK_INT (XCDR (instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 CHECK_STRING (instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 f->instructions = instructions;
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 if (!NILP (constants))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 CHECK_VECTOR (constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 f->constants = constants;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 CHECK_NATNUM (stack_depth);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2041 f->stack_depth = (unsigned short) XINT (stack_depth);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 #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
2044 f->annotated = Vload_file_name_internal;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
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 /* doc_string may be nil, string, int, or a cons (string . int).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 interactive may be list or string (or unbound). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 f->doc_and_interactive = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 if ((f->flags.domainp = !NILP (Vfile_domain)) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 f->doc_and_interactive = Vfile_domain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 if ((f->flags.interactivep = !UNBOUNDP (interactive)) != 0)
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 f->doc_and_interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 = (UNBOUNDP (f->doc_and_interactive) ? interactive :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 Fcons (interactive, f->doc_and_interactive));
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 ((f->flags.documentationp = !NILP (doc_string)) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 f->doc_and_interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 = (UNBOUNDP (f->doc_and_interactive) ? doc_string :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 Fcons (doc_string, f->doc_and_interactive));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 if (UNBOUNDP (f->doc_and_interactive))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 f->doc_and_interactive = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 return fun;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 /* Symbol allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2077 DECLARE_FIXED_TYPE_ALLOC (symbol, Lisp_Symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_symbol 1000
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 DEFUN ("make-symbol", Fmake_symbol, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 Return a newly allocated uninterned symbol whose name is NAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 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
2083 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 (name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2086 Lisp_Symbol *p;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 CHECK_STRING (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2090 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
2091 p->name = name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 p->plist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 p->value = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 p->function = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 symbol_next (p) = 0;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2096 return wrap_symbol (p);
428
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
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 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 /* Extent allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 /************************************************************************/
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 DECLARE_FIXED_TYPE_ALLOC (extent, struct extent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_extent 1000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 struct extent *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 allocate_extent (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 struct extent *e;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2112 ALLOC_FROB_BLOCK_LISP_OBJECT (extent, struct extent, e, &lrecord_extent);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 extent_object (e) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 set_extent_start (e, -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 set_extent_end (e, -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 e->plist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 xzero (e->flags);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 extent_face (e) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 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
2122 e->flags.detachable = 1;
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 return e;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 }
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 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 /* Event allocation */
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
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2132 DECLARE_FIXED_TYPE_ALLOC (event, Lisp_Event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_event 1000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 allocate_event (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2138 Lisp_Event *e;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2139
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2140 ALLOC_FROB_BLOCK_LISP_OBJECT (event, Lisp_Event, e, &lrecord_event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2142 return wrap_event (e);
428
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
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2145 #ifdef EVENT_DATA_AS_OBJECTS
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2146 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
2147 #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
2148
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2149 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2150 make_key_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2151 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2152 Lisp_Key_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2153
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2154 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
2155 &lrecord_key_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2156 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
2157 d->keysym = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2158
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2159 return wrap_key_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2160 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2161
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2162 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
2163 #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
2164
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2165 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2166 make_button_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2167 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2168 Lisp_Button_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2169
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
2170 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
2171 &lrecord_button_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2172 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
2173 return wrap_button_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2174 }
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 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
2177 #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
2178
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2179 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2180 make_motion_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2181 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2182 Lisp_Motion_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2183
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
2184 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
2185 &lrecord_motion_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2186 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
2187
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2188 return wrap_motion_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2189 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2190
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2191 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
2192 #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
2193
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2194 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2195 make_process_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2196 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2197 Lisp_Process_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2198
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
2199 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
2200 &lrecord_process_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2201 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
2202 d->process = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2203
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2204 return wrap_process_data (d);
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
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2207 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
2208 #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
2209
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2210 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2211 make_timeout_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2212 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2213 Lisp_Timeout_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2214
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
2215 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
2216 &lrecord_timeout_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2217 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
2218 d->function = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2219 d->object = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2220
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2221 return wrap_timeout_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2222 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2223
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2224 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
2225 #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
2226
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2227 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2228 make_magic_data (void)
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 Lisp_Magic_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2231
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
2232 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
2233 &lrecord_magic_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2234 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
2235
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2236 return wrap_magic_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2237 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2238
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2239 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
2240 #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
2241
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2242 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2243 make_magic_eval_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2244 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2245 Lisp_Magic_Eval_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2246
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
2247 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
2248 &lrecord_magic_eval_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2249 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
2250 d->object = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2251
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2252 return wrap_magic_eval_data (d);
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
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2255 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
2256 #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
2257
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2258 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2259 make_eval_data (void)
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2260 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2261 Lisp_Eval_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2262
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
2263 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
2264 &lrecord_eval_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2265 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
2266 d->function = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2267 d->object = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2268
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2269 return wrap_eval_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2270 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2271
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2272 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
2273 #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
2274
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2275 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2276 make_misc_user_data (void)
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 Lisp_Misc_User_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2279
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
2280 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
2281 &lrecord_misc_user_data);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2282 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
2283 d->function = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2284 d->object = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2285
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2286 return wrap_misc_user_data (d);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2287 }
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2288
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2289 #endif /* EVENT_DATA_AS_OBJECTS */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 /* Marker allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2295 DECLARE_FIXED_TYPE_ALLOC (marker, Lisp_Marker);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_marker 1000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 DEFUN ("make-marker", Fmake_marker, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 Return a new marker which does not point at any place.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2303 Lisp_Marker *p;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2304
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2305 ALLOC_FROB_BLOCK_LISP_OBJECT (marker, Lisp_Marker, p, &lrecord_marker);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 p->buffer = 0;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2307 p->membpos = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 marker_next (p) = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 marker_prev (p) = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 p->insertion_type = 0;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2311 return wrap_marker (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 noseeum_make_marker (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2317 Lisp_Marker *p;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2318
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2319 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
2320 &lrecord_marker);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 p->buffer = 0;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2322 p->membpos = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 marker_next (p) = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 marker_prev (p) = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 p->insertion_type = 0;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2326 return wrap_marker (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 /* String allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 /* The data for "short" strings generally resides inside of structs of type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 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
2336 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
2337 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
2338 large strings do not.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 Previously Lisp_String structures were relocated, but this caused a lot
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 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
2342 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
2343 that the reference would get relocated).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 This new method makes things somewhat bigger, but it is MUCH safer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2347 DECLARE_FIXED_TYPE_ALLOC (string, Lisp_String);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 /* strings are used and freed quite often */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 10000 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 1000
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 mark_string (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2355 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
2356 flush_cached_extent_info (XCAR (XSTRING_PLIST (obj)));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2357 return XSTRING_PLIST (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 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
2361 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
2362 int foldcase)
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 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
2365 if (foldcase)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
2366 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
2367 else
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
2368 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
2369 !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2), len));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
2372 static const struct memory_description string_description[] = {
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2373 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2374 { XD_LISP_OBJECT, offsetof (Lisp_String, data_object) },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2375 #else /* not NEW_GC */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2376 { XD_BYTECOUNT, offsetof (Lisp_String, size_) },
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2377 { 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
2378 #endif /* not NEW_GC */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2379 { XD_LISP_OBJECT, offsetof (Lisp_String, plist) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2383 /* 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
2384 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
2385 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
2386 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
2387 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
2388 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
2389 extent info.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2390
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2391 #### 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
2392
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2393 static Lisp_Object *
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2394 string_plist_ptr (Lisp_Object string)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2395 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2396 Lisp_Object *ptr = &XSTRING_PLIST (string);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2397
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2398 if (CONSP (*ptr) && EXTENT_INFOP (XCAR (*ptr)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2399 ptr = &XCDR (*ptr);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2400 if (CONSP (*ptr) && INTP (XCAR (*ptr)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2401 ptr = &XCDR (*ptr);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2402 return ptr;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2403 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2404
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2405 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2406 string_getprop (Lisp_Object string, Lisp_Object property)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2407 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2408 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
2409 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2410
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2411 static int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2412 string_putprop (Lisp_Object string, Lisp_Object property, Lisp_Object value)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2413 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2414 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
2415 return 1;
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
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2418 static int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2419 string_remprop (Lisp_Object string, Lisp_Object property)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2420 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2421 return external_remprop (string_plist_ptr (string), property, 0, ERROR_ME);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2422 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2423
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2424 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2425 string_plist (Lisp_Object string)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2426 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2427 return *string_plist_ptr (string);
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
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
2430 #ifndef NEW_GC
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2431 /* No `finalize', or `hash' methods.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2432 internal_hash() already knows how to hash strings and finalization
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2433 is done with the ADDITIONAL_FREE_string macro, which is the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2434 standard way to do finalization when using
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2435 SWEEP_FIXED_TYPE_BLOCK(). */
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
2436
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
2437 DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT ("string", string,
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2438 mark_string, print_string,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2439 0, string_equal, 0,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2440 string_description,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2441 string_getprop,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2442 string_putprop,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2443 string_remprop,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2444 string_plist,
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
2445 0 /* no disksaver */,
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
2446 Lisp_String);
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
2447 #endif /* not NEW_GC */
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
2448
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2449 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2450 #define STRING_FULLSIZE(size) \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2451 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
2452 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 /* String blocks contain this many useful bytes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 #define STRING_CHARS_BLOCK_SIZE \
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2455 ((Bytecount) (8192 - MALLOC_OVERHEAD - \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2456 ((2 * sizeof (struct string_chars_block *)) \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2457 + sizeof (EMACS_INT))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 /* Block header for small strings. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 struct string_chars_block
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 EMACS_INT pos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 struct string_chars_block *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 struct string_chars_block *prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 /* Contents of string_chars_block->string_chars are interleaved
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 string_chars structures (see below) and the actual string data */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 unsigned char string_chars[STRING_CHARS_BLOCK_SIZE];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 static struct string_chars_block *first_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470 static struct string_chars_block *current_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 /* 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
2473 * the string occupies in string_chars_block->string_chars
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 * (including alignment padding).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 */
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2476 #define STRING_FULLSIZE(size) \
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2477 ALIGN_FOR_TYPE (((size) + 1 + sizeof (Lisp_String *)), Lisp_String *)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 #define BIG_STRING_FULLSIZE_P(fullsize) ((fullsize) >= STRING_CHARS_BLOCK_SIZE)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 #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
2481
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
2482 #define STRING_CHARS_FREE_P(ptr) ((ptr)->string == NULL)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
2483 #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
2484 #endif /* not NEW_GC */
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
2485
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
2486 #ifdef NEW_GC
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
2487 DEFINE_DUMPABLE_GENERAL_LISP_OBJECT ("string", string,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
2488 mark_string, print_string,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
2489 0,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
2490 string_equal, 0,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
2491 string_description,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
2492 string_getprop,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
2493 string_putprop,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
2494 string_remprop,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
2495 string_plist,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
2496 0 /* no disksaver */,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
2497 Lisp_String);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2498
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2499
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2500 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
2501 { 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
2502 { XD_END }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2503 };
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2504
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2505 static Bytecount
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2506 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
2507 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2508 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
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
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2512 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
2513 string_direct_data,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2514 0,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2515 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
2516 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
2517 Lisp_String_Direct_Data);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2518
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2519
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2520 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
2521 { XD_BYTECOUNT, offsetof (Lisp_String_Indirect_Data, size) },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2522 { 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
2523 XD_INDIRECT(0, 1) },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2524 { XD_END }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2525 };
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2526
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2527 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
2528 string_indirect_data,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2529 0,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
2530 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
2531 Lisp_String_Indirect_Data);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2532 #endif /* NEW_GC */
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
2533
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2534 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535 struct string_chars
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2537 Lisp_String *string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 unsigned char chars[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541 struct unused_string_chars
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2543 Lisp_String *string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544 EMACS_INT fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 init_string_chars_alloc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 first_string_chars_block = xnew (struct string_chars_block);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 first_string_chars_block->prev = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 first_string_chars_block->next = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 first_string_chars_block->pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 current_string_chars_block = first_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556
1550
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2557 static Ibyte *
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2558 allocate_big_string_chars (Bytecount length)
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2559 {
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2560 Ibyte *p = xnew_array (Ibyte, length);
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2561 INCREMENT_CONS_COUNTER (length, "string chars");
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2562 return p;
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2563 }
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2564
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 static struct string_chars *
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2566 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
2567 Bytecount fullsize)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 struct string_chars *s_chars;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2571 if (fullsize <=
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2572 (countof (current_string_chars_block->string_chars)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2573 - current_string_chars_block->pos))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2574 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2575 /* This string can fit in the current string chars block */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2576 s_chars = (struct string_chars *)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577 (current_string_chars_block->string_chars
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578 + current_string_chars_block->pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 current_string_chars_block->pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2581 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2582 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 /* Make a new current string chars block */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584 struct string_chars_block *new_scb = xnew (struct string_chars_block);
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 current_string_chars_block->next = new_scb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587 new_scb->prev = current_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2588 new_scb->next = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 current_string_chars_block = new_scb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2590 new_scb->pos = fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591 s_chars = (struct string_chars *)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2592 current_string_chars_block->string_chars;
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
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2595 s_chars->string = XSTRING (string_it_goes_with);
428
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 INCREMENT_CONS_COUNTER (fullsize, "string chars");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2599 return s_chars;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2600 }
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2601 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2602
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2603 #ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2604 void
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2605 sledgehammer_check_ascii_begin (Lisp_Object str)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2606 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2607 Bytecount i;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2608
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2609 for (i = 0; i < XSTRING_LENGTH (str); i++)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2610 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2611 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
2612 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2613 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2614
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2615 assert (i == (Bytecount) XSTRING_ASCII_BEGIN (str) ||
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2616 (i > MAX_STRING_ASCII_BEGIN &&
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2617 (Bytecount) XSTRING_ASCII_BEGIN (str) ==
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2618 (Bytecount) MAX_STRING_ASCII_BEGIN));
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 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2621
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2622 /* 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
2623 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
2624 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
2625
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627 make_uninit_string (Bytecount length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2629 Lisp_String *s;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2630 Bytecount fullsize = STRING_FULLSIZE (length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2631
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2632 assert (length >= 0 && fullsize > 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2633
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
2634 #ifdef NEW_GC
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
2635 s = XSTRING (ALLOC_NORMAL_LISP_OBJECT (string));
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
2636 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637 /* Allocate the string header */
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2638 ALLOCATE_FIXED_TYPE (string, Lisp_String, s);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2639 xzero (*s);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2640 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
2641 #endif /* not NEW_GC */
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
2642
3063
d30cd499e445 [xemacs-hg @ 2005-11-13 10:48:01 by ben]
ben
parents: 3024
diff changeset
2643 /* 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
2644 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
2645 XSET_STRING_ASCII_BEGIN (wrap_string (s), 0);
d30cd499e445 [xemacs-hg @ 2005-11-13 10:48:01 by ben]
ben
parents: 3024
diff changeset
2646
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2647 #ifdef NEW_GC
3304
73051095a712 [xemacs-hg @ 2006-03-26 14:33:37 by crestani]
crestani
parents: 3263
diff changeset
2648 set_lispstringp_direct (s);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2649 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
2650 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
2651 #else /* not NEW_GC */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2652 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
2653 ? allocate_big_string_chars (length + 1)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
2654 : allocate_string_chars_struct (wrap_string (s),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
2655 fullsize)->chars);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2656 #endif /* not NEW_GC */
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2657
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2658 set_lispstringp_length (s, length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 s->plist = Qnil;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2660 set_string_byte (wrap_string (s), length, 0);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2661
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2662 return wrap_string (s);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 #ifdef VERIFY_STRING_CHARS_INTEGRITY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 static void verify_string_chars_integrity (void);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2667 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 /* Resize the string S so that DELTA bytes can be inserted starting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 at POS. If DELTA < 0, it means deletion starting at POS. If
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 POS < 0, resize the string but don't copy any characters. Use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 this if you're planning on completely overwriting the string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 */
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 void
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2676 resize_string (Lisp_Object s, Bytecount pos, Bytecount delta)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 {
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2678 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2679 Bytecount newfullsize, len;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2680 #else /* not NEW_GC */
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2681 Bytecount oldfullsize, newfullsize;
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2682 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 #ifdef VERIFY_STRING_CHARS_INTEGRITY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 verify_string_chars_integrity ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 #endif
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
2686 #ifdef ERROR_CHECK_TEXT
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687 if (pos >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2689 assert (pos <= XSTRING_LENGTH (s));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690 if (delta < 0)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2691 assert (pos + (-delta) <= XSTRING_LENGTH (s));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695 if (delta < 0)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2696 assert ((-delta) <= XSTRING_LENGTH (s));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697 }
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
2698 #endif /* ERROR_CHECK_TEXT */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700 if (delta == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 /* simplest case: no size change. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2702 return;
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2703
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2704 if (pos >= 0 && delta < 0)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2705 /* If DELTA < 0, the functions below will delete the characters
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2706 before POS. We want to delete characters *after* POS, however,
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2707 so convert this to the appropriate form. */
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2708 pos += -delta;
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2709
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2710 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2711 newfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s) + delta);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2712
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2713 len = XSTRING_LENGTH (s) + 1 - pos;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2714
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2715 if (delta < 0 && pos >= 0)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2716 memmove (XSTRING_DATA (s) + pos + delta,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2717 XSTRING_DATA (s) + pos, len);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2718
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2719 XSTRING_DATA_OBJECT (s) =
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2720 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
2721 newfullsize));
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2722 if (delta > 0 && pos >= 0)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2723 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
2724 len);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2725
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
2726 #else /* not NEW_GC */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2727 oldfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2728 newfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s) + delta);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2729
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2730 if (BIG_STRING_FULLSIZE_P (oldfullsize))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2732 if (BIG_STRING_FULLSIZE_P (newfullsize))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2733 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2734 /* Both strings are big. We can just realloc().
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2735 But careful! If the string is shrinking, we have to
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2736 memmove() _before_ realloc(), and if growing, we have to
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2737 memmove() _after_ realloc() - otherwise the access is
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2738 illegal, and we might crash. */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2739 Bytecount len = XSTRING_LENGTH (s) + 1 - pos;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2740
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2741 if (delta < 0 && pos >= 0)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2742 memmove (XSTRING_DATA (s) + pos + delta,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2743 XSTRING_DATA (s) + pos, len);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2744 XSET_STRING_DATA
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2745 (s, (Ibyte *) xrealloc (XSTRING_DATA (s),
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2746 XSTRING_LENGTH (s) + delta + 1));
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2747 if (delta > 0 && pos >= 0)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2748 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
2749 len);
1550
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2750 /* Bump the cons counter.
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2751 Conservative; Martin let the increment be delta. */
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2752 INCREMENT_CONS_COUNTER (newfullsize, "string chars");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2753 }
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2754 else /* String has been demoted from BIG_STRING. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2756 Ibyte *new_data =
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2757 allocate_string_chars_struct (s, newfullsize)->chars;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2758 Ibyte *old_data = XSTRING_DATA (s);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2759
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2760 if (pos >= 0)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2761 {
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2762 memcpy (new_data, old_data, pos);
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2763 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
2764 XSTRING_LENGTH (s) + 1 - pos);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2765 }
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2766 XSET_STRING_DATA (s, new_data);
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4969
diff changeset
2767 xfree (old_data);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2768 }
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2769 }
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2770 else /* old string is small */
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2771 {
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2772 if (oldfullsize == newfullsize)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2773 {
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2774 /* special case; size change but the necessary
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2775 allocation size won't change (up or down; code
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2776 somewhere depends on there not being any unused
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2777 allocation space, modulo any alignment
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2778 constraints). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2779 if (pos >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2780 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2781 Ibyte *addroff = pos + XSTRING_DATA (s);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783 memmove (addroff + delta, addroff,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 /* +1 due to zero-termination. */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2785 XSTRING_LENGTH (s) + 1 - pos);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2786 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2790 Ibyte *old_data = XSTRING_DATA (s);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2791 Ibyte *new_data =
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2792 BIG_STRING_FULLSIZE_P (newfullsize)
1550
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent]
stephent
parents: 1346
diff changeset
2793 ? allocate_big_string_chars (XSTRING_LENGTH (s) + delta + 1)
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2794 : allocate_string_chars_struct (s, newfullsize)->chars;
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2795
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796 if (pos >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2798 memcpy (new_data, old_data, pos);
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2799 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
2800 XSTRING_LENGTH (s) + 1 - pos);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 }
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2802 XSET_STRING_DATA (s, new_data);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2803
4776
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2804 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
2805 {
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2806 /* 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
2807 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
2808 freak. */
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2809 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
2810 ((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
2811 /* 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
2812 alignment/padding. */
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2813 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
2814 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
2815 ((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
2816 oldfullsize;
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string()
Aidan Kehoe <kehoea@parhasard.net>
parents: 4735
diff changeset
2817 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818 }
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2819 }
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
2820 #endif /* not NEW_GC */
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2821
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2822 XSET_STRING_LENGTH (s, XSTRING_LENGTH (s) + delta);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2823 /* If pos < 0, the string won't be zero-terminated.
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2824 Terminate now just to make sure. */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2825 XSTRING_DATA (s)[XSTRING_LENGTH (s)] = '\0';
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2826
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2827 if (pos >= 0)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2828 /* 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
2829 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
2830 adjust_extents() is exclusive of the starting position
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2831 passed to it. */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2832 adjust_extents (s, pos - 1, XSTRING_LENGTH (s), delta);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 #ifdef VERIFY_STRING_CHARS_INTEGRITY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835 verify_string_chars_integrity ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2840
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2841 /* 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
2842 CHECK_LISP_WRITEABLE() before and bump_string_modiff() afterwards. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843 void
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2844 set_string_char (Lisp_Object s, Charcount i, Ichar c)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2846 Ibyte newstr[MAX_ICHAR_LEN];
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2847 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
2848 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
2849 Bytecount newlen = set_itext_ichar (newstr, c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2851 sledgehammer_check_ascii_begin (s);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2852 if (oldlen != newlen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2853 resize_string (s, bytoff, newlen - oldlen);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2854 /* 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
2855 memcpy (XSTRING_DATA (s) + bytoff, newstr, newlen);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2856 if (oldlen != newlen)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2857 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2858 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
2859 /* 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
2860 ascii_begin */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2861 XSET_STRING_ASCII_BEGIN (s, i);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2862 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
2863 /* 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
2864 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2865 Bytecount j;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2866 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
2867 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2868 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
2869 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2870 }
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2871 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
2872 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2873 }
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2874 sledgehammer_check_ascii_begin (s);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2875 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2878
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2879 DEFUN ("make-string", Fmake_string, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2880 Return a new string consisting of LENGTH copies of CHARACTER.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2881 LENGTH must be a non-negative integer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2883 (length, character))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2884 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2885 CHECK_NATNUM (length);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2886 CHECK_CHAR_COERCE_INT (character);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2888 Ibyte init_str[MAX_ICHAR_LEN];
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2889 int len = set_itext_ichar (init_str, XCHAR (character));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2890 Lisp_Object val = make_uninit_string (len * XINT (length));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2891
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2892 if (len == 1)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2893 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2894 /* Optimize the single-byte case */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2895 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
2896 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
2897 len * XINT (length)));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2898 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2899 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2900 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 617
diff changeset
2901 EMACS_INT i;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2902 Ibyte *ptr = XSTRING_DATA (val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2903
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2904 for (i = XINT (length); i; i--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2905 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2906 Ibyte *init_ptr = init_str;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2907 switch (len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2908 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2909 case 4: *ptr++ = *init_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2910 case 3: *ptr++ = *init_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2911 case 2: *ptr++ = *init_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2912 case 1: *ptr++ = *init_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2913 }
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 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2916 sledgehammer_check_ascii_begin (val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2917 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2918 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2921 DEFUN ("string", Fstring, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 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
2923
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3514
diff changeset
2924 arguments: (&rest ARGS)
428
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 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2927 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
2928 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
2929 Ibyte *p = storage;
428
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 for (; nargs; nargs--, args++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2932 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2933 Lisp_Object lisp_char = *args;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2934 CHECK_CHAR_COERCE_INT (lisp_char);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2935 p += set_itext_ichar (p, XCHAR (lisp_char));
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 return make_string (storage, p - storage);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2938 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2939
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2940 /* 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
2941
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2942 void
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2943 init_string_ascii_begin (Lisp_Object string)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2944 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2945 #ifdef MULE
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2946 int i;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2947 Bytecount length = XSTRING_LENGTH (string);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2948 Ibyte *contents = XSTRING_DATA (string);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2949
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2950 for (i = 0; i < length; i++)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2951 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2952 if (!byte_ascii_p (contents[i]))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2953 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2954 }
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2955 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
2956 #else
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
2957 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
2958 MAX_STRING_ASCII_BEGIN));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2959 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2960 sledgehammer_check_ascii_begin (string);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2961 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2962
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2963 /* Take some raw memory, which MUST already be in internal format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964 and package it up into a Lisp string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2965 Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
2966 make_string (const Ibyte *contents, Bytecount length)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2967 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2968 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2969
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2970 /* 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
2971 #if defined (ERROR_CHECK_TEXT) && defined (MULE)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2972 bytecount_to_charcount (contents, length); /* Just for the assertions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2973 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 val = make_uninit_string (length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2976 memcpy (XSTRING_DATA (val), contents, length);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2977 init_string_ascii_begin (val);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2978 sledgehammer_check_ascii_begin (val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979 return 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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982 /* Take some raw memory, encoded in some external data format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983 and convert it into a Lisp string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2984 Lisp_Object
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
2985 make_extstring (const Extbyte *contents, EMACS_INT length,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2986 Lisp_Object coding_system)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2988 Lisp_Object string;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2989 TO_INTERNAL_FORMAT (DATA, (contents, length),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2990 LISP_STRING, string,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2991 coding_system);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2992 return string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994
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 build_istring (const Ibyte *str)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2997 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2998 /* 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
2999 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
3000 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3001
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3002 Lisp_Object
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3003 build_cistring (const CIbyte *str)
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3004 {
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3005 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
3006 }
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3007
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3008 Lisp_Object
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3009 build_ascstring (const Ascbyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3010 {
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3011 ASSERT_ASCTEXT_ASCII (str);
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3012 return build_istring ((const Ibyte *) str);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 Lisp_Object
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3016 build_extstring (const Extbyte *str, Lisp_Object coding_system)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018 /* 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
3019 return make_extstring ((const Extbyte *) str,
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
3020 (str ? dfc_external_data_len (str, coding_system) :
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
3021 0),
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3022 coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3023 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3025 /* 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
3026 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
3027
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 Lisp_Object
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3029 build_msg_istring (const Ibyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3030 {
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3031 return build_istring (IGETTEXT (str));
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3032 }
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3033
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3034 /* 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
3035 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
3036
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3037 Lisp_Object
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3038 build_msg_cistring (const CIbyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3039 {
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3040 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
3041 }
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3042
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3043 /* 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
3044 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
3045 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
3046 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
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_ascstring (const Ascbyte *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 ASSERT_ASCTEXT_ASCII (str);
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3052 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
3053 }
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3054
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3055 /* 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
3056 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
3057 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
3058 translated.
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3059
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3060 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
3061 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
3062 properly. */
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3063
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3064 Lisp_Object
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3065 build_defer_istring (const Ibyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3066 {
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3067 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
3068 /* 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
3069 return retval;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3070 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3071
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 Lisp_Object
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3073 build_defer_cistring (const CIbyte *str)
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 return build_defer_istring ((Ibyte *) str);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3076 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3077
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3078 Lisp_Object
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3079 build_defer_ascstring (const Ascbyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3080 {
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3081 ASSERT_ASCTEXT_ASCII (str);
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3082 return build_defer_istring ((Ibyte *) str);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3084
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085 Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
3086 make_string_nocopy (const Ibyte *contents, Bytecount length)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
3088 Lisp_String *s;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3089 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3090
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091 /* 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
3092 #if defined (ERROR_CHECK_TEXT) && defined (MULE)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093 bytecount_to_charcount (contents, length); /* Just for the assertions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3096 #ifdef NEW_GC
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3097 s = XSTRING (ALLOC_NORMAL_LISP_OBJECT (string));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3098 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
3099 collected and static data is tried to
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3100 be freed. */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3101 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 /* Allocate the string header */
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
3103 ALLOCATE_FIXED_TYPE (string, Lisp_String, s);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3104 set_lheader_implementation (&s->u.lheader, &lrecord_string);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3105 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
3106 #endif /* not NEW_GC */
3063
d30cd499e445 [xemacs-hg @ 2005-11-13 10:48:01 by ben]
ben
parents: 3024
diff changeset
3107 /* 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
3108 init_string_ascii_begin(). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109 s->plist = Qnil;
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
3110 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
3111 set_lispstringp_indirect (s);
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3112 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
3113 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
3114 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
3115 #else /* not NEW_GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
3116 set_lispstringp_data (s, (Ibyte *) contents);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
3117 set_lispstringp_length (s, length);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
3118 #endif /* not NEW_GC */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
3119 val = wrap_string (s);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3120 init_string_ascii_begin (val);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3121 sledgehammer_check_ascii_begin (val);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3122
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3123 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3124 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3126
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3127 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3128 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129 /* lcrecord lists */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3132 /* 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
3133 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
3134 malloc() and garbage-collection junk) as much as possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3135 It is similar to the Blocktype class.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3136
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3137 See detailed comment in lcrecord.h.
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3138 */
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3139
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3140 const struct memory_description free_description[] = {
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2532
diff changeset
3141 { 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
3142 XD_FLAG_FREE_LISP_OBJECT },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3143 { XD_END }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3144 };
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3145
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
3146 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
3147 struct free_lcrecord_header);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3148
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3149 const struct memory_description lcrecord_list_description[] = {
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2532
diff changeset
3150 { 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
3151 XD_FLAG_FREE_LISP_OBJECT },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3152 { XD_END }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3153 };
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3155 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3156 mark_lcrecord_list (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158 struct lcrecord_list *list = XLCRECORD_LIST (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159 Lisp_Object chain = list->free;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3161 while (!NILP (chain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 struct lrecord_header *lheader = XRECORD_LHEADER (chain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 struct free_lcrecord_header *free_header =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165 (struct free_lcrecord_header *) lheader;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3167 gc_checking_assert
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3168 (/* There should be no other pointers to the free list. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3169 ! MARKED_RECORD_HEADER_P (lheader)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3170 &&
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3171 /* Only lcrecords should be here. */
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3172 ! list->implementation->frob_block_p
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3173 &&
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3174 /* 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
3175 lheader->free
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3176 &&
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3177 /* 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
3178 lheader->type == lrecord_type_free
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3179 &&
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3180 /* So must the size. */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3181 (list->implementation->static_size == 0 ||
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3182 list->implementation->static_size == list->size)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3183 );
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185 MARK_RECORD_HEADER (lheader);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186 chain = free_header->chain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3190 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3191
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
3192 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
3193 mark_lcrecord_list,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
3194 lcrecord_list_description,
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
3195 struct lcrecord_list);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
3196
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 Lisp_Object
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3198 make_lcrecord_list (Elemcount size,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3199 const struct lrecord_implementation *implementation)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 {
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
3201 /* 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
3202 allocating this. */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3203 struct lcrecord_list *p = (struct lcrecord_list *)
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
3204 old_alloc_lcrecord (&lrecord_lcrecord_list);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206 p->implementation = implementation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207 p->size = size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 p->free = Qnil;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
3209 return wrap_lcrecord_list (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3210 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3212 Lisp_Object
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3213 alloc_managed_lcrecord (Lisp_Object lcrecord_list)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3214 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215 struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 if (!NILP (list->free))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 Lisp_Object val = list->free;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219 struct free_lcrecord_header *free_header =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220 (struct free_lcrecord_header *) XPNTR (val);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3221 struct lrecord_header *lheader = &free_header->lcheader.lheader;
428
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 #ifdef ERROR_CHECK_GC
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3224 /* Major overkill here. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3225 /* There should be no other pointers to the free list. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3226 assert (! MARKED_RECORD_HEADER_P (lheader));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 /* 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
3228 assert (lheader->free);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3229 assert (lheader->type == lrecord_type_free);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3230 /* Only lcrecords should be here. */
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3231 assert (! (list->implementation->frob_block_p));
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3232 #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
3233 lrecord_type_free. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 /* The type of the lcrecord must be right. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3235 assert (LHEADER_IMPLEMENTATION (lheader) == list->implementation);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3236 #endif /* 0 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 /* So must the size. */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3238 assert (list->implementation->static_size == 0 ||
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3239 list->implementation->static_size == list->size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 #endif /* ERROR_CHECK_GC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3241
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242 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
3243 lheader->free = 0;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3244 /* 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
3245 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
3246 zero_sized_lisp_object (val, list->size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 else
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
3250 return wrap_pointer_1 (old_alloc_sized_lcrecord (list->size,
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
3251 list->implementation));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3254 /* "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
3255 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
3256 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
3257 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
3258 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
3259 used!
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3260
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3261 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
3262 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
3263
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3264 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265 free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3266 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3267 struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268 struct free_lcrecord_header *free_header =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269 (struct free_lcrecord_header *) XPNTR (lcrecord);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3270 struct lrecord_header *lheader = &free_header->lcheader.lheader;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3271 const struct lrecord_implementation *implementation
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272 = LHEADER_IMPLEMENTATION (lheader);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273
4880
ae81a2c00f4f try harder to avoid crashing when debug-printing
Ben Wing <ben@xemacs.org>
parents: 4803
diff changeset
3274 /* 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
3275 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
3276 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
3277 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
3278 super long-lived afterwards, anyway. */
ae81a2c00f4f try harder to avoid crashing when debug-printing
Ben Wing <ben@xemacs.org>
parents: 4803
diff changeset
3279 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
3280 return;
ae81a2c00f4f try harder to avoid crashing when debug-printing
Ben Wing <ben@xemacs.org>
parents: 4803
diff changeset
3281
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3282 /* 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
3283 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
3284 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
3285 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
3286 (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
3287 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
3288 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
3289 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
3290 problems. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3291 gc_checking_assert (!gc_in_progress);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3292
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3293 /* Make sure the size is correct. This will catch, for example,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3294 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
3295 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
3296 /* 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
3297 gc_checking_assert (!lheader->free);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
3298 /* 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
3299 may need to check for this before freeing. */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
3300 gc_checking_assert (!OBJECT_DUMPED_P (lcrecord));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3301
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3302 if (implementation->finalizer)
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3303 implementation->finalizer (lcrecord);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3304 /* 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
3305 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
3306 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
3307 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
3308 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
3309 MARK_LRECORD_AS_FREE (lheader);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3310 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
3311 lheader->free = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312 list->free = lcrecord;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3313 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3314
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3315 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
3316
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3317 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3318 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
3319 const struct lrecord_implementation *imp)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3320 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3321 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
3322 all_lcrecord_lists[imp->lrecord_type_index] =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3323 make_lcrecord_list (size, imp);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3324
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3325 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
3326 }
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3327
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3328 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3329 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
3330 {
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
3331 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
3332 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
3333 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3334
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3335 void
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
3336 old_free_lcrecord (Lisp_Object rec)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3337 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3338 int type = XRECORD_LHEADER (rec)->type;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3339
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3340 assert (!EQ (all_lcrecord_lists[type], Qzero));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3341
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3342 free_managed_lcrecord (all_lcrecord_lists[type], rec);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3343 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3344 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3347 DEFUN ("purecopy", Fpurecopy, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3348 Kept for compatibility, returns its argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3349 Old:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3350 Make a copy of OBJECT in pure storage.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3351 Recursively copies contents of vectors and cons cells.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3352 Does not copy symbols.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3353 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3354 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3355 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3356 return object;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3357 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3359
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3360 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3361 /* Garbage Collection */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3362 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3363
1676
a72f7bf813c9 [xemacs-hg @ 2003-09-11 09:11:07 by crestani]
crestani
parents: 1643
diff changeset
3364 #ifndef USE_KKCC
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3365 /* Object marker functions are in the lrecord_implementation structure.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3366 But copying them to a parallel array is much more cache-friendly.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3367 This hack speeds up (garbage-collect) by about 5%. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3368 Lisp_Object (*lrecord_markers[countof (lrecord_implementations_table)]) (Lisp_Object);
1676
a72f7bf813c9 [xemacs-hg @ 2003-09-11 09:11:07 by crestani]
crestani
parents: 1643
diff changeset
3369 #endif /* not USE_KKCC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3371 struct gcpro *gcprolist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3372
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3373 /* 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
3374 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
3375 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
3376 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
3377 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
3378 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
3379 "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
3380 static const struct memory_description staticpro_description_1[] = {
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3381 { XD_END }
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3382 };
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3383
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3384 static const struct sized_memory_description staticpro_description = {
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3385 sizeof (Lisp_Object *),
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3386 staticpro_description_1
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3387 };
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3388
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3389 static const struct memory_description staticpros_description_1[] = {
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3390 XD_DYNARR_DESC (Lisp_Object_ptr_dynarr, &staticpro_description),
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3391 { XD_END }
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3392 };
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3393
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3394 static const struct sized_memory_description staticpros_description = {
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3395 sizeof (Lisp_Object_ptr_dynarr),
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3396 staticpros_description_1
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3397 };
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3398
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3399 #ifdef DEBUG_XEMACS
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3400
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3401 /* 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
3402
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3403 Lisp_Object_ptr_dynarr *staticpros;
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3404 const_Ascbyte_ptr_dynarr *staticpro_names;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3405
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3406 /* 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
3407 garbage collection, and for dumping. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3408 void
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3409 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
3410 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3411 Dynarr_add (staticpros, varaddress);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3412 Dynarr_add (staticpro_names, varname);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3413 dump_add_root_lisp_object (varaddress);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3414 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3415
5016
2ade80e8c640 enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents: 4976
diff changeset
3416 const Ascbyte *staticpro_name (int count);
2ade80e8c640 enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents: 4976
diff changeset
3417
4934
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3418 /* 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
3419 COUNT. */
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3420 const Ascbyte *
4934
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3421 staticpro_name (int count)
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3422 {
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3423 return Dynarr_at (staticpro_names, count);
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3424 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3425
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3426 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
3427 const_Ascbyte_ptr_dynarr *staticpro_nodump_names;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3428
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3429 /* 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
3430 garbage collection, but not for dumping. (See below.) */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3431 void
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3432 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
3433 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3434 Dynarr_add (staticpros_nodump, varaddress);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3435 Dynarr_add (staticpro_nodump_names, varname);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3436 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3437
5016
2ade80e8c640 enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents: 4976
diff changeset
3438 const Ascbyte *staticpro_nodump_name (int count);
2ade80e8c640 enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents: 4976
diff changeset
3439
4934
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3440 /* 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
3441 COUNT. */
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3442 const Ascbyte *
4934
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3443 staticpro_nodump_name (int count)
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3444 {
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3445 return Dynarr_at (staticpro_nodump_names, count);
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3446 }
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3447
996
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3448 #ifdef HAVE_SHLIB
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3449 /* 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
3450 for garbage collection, but not for dumping. */
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3451 void
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3452 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
3453 {
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3454 Dynarr_delete_object (staticpros, varaddress);
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3455 Dynarr_delete_object (staticpro_names, varname);
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3456 }
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3457 #endif
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3458
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3459 #else /* not DEBUG_XEMACS */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3460
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3461 Lisp_Object_ptr_dynarr *staticpros;
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3462
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3463 /* 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
3464 garbage collection, and for dumping. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3465 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3466 staticpro (Lisp_Object *varaddress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3467 {
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3468 Dynarr_add (staticpros, varaddress);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3469 dump_add_root_lisp_object (varaddress);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3470 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3471
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3472
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3473 Lisp_Object_ptr_dynarr *staticpros_nodump;
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3474
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3475 /* 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
3476 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
3477 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
3478 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
3479 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
3480 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
3481 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
3482 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
3483 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
3484 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
3485 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
3486 reloaded at a different address.)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3487
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3488 #### 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
3489 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
3490 loads the data in. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3491
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3492 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 staticpro_nodump (Lisp_Object *varaddress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494 {
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
3495 Dynarr_add (staticpros_nodump, varaddress);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3496 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497
996
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3498 #ifdef HAVE_SHLIB
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3499 /* 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
3500 garbage collection, but not for dumping. */
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3501 void
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3502 unstaticpro_nodump (Lisp_Object *varaddress)
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3503 {
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3504 Dynarr_delete_object (staticpros, varaddress);
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3505 }
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3506 #endif
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james]
james
parents: 945
diff changeset
3507
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3508 #endif /* not DEBUG_XEMACS */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3509
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3510
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3511
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3512
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3513
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3514 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3515 static const struct memory_description mcpro_description_1[] = {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3516 { XD_END }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3517 };
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3518
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3519 static const struct sized_memory_description mcpro_description = {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3520 sizeof (Lisp_Object *),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3521 mcpro_description_1
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3522 };
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3523
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3524 static const struct memory_description mcpros_description_1[] = {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3525 XD_DYNARR_DESC (Lisp_Object_dynarr, &mcpro_description),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3526 { XD_END }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3527 };
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3528
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3529 static const struct sized_memory_description mcpros_description = {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3530 sizeof (Lisp_Object_dynarr),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3531 mcpros_description_1
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
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3534 #ifdef DEBUG_XEMACS
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3535
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3536 /* 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
3537
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3538 Lisp_Object_dynarr *mcpros;
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3539 const_Ascbyte_ptr_dynarr *mcpro_names;
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3540
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3541 /* 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
3542 garbage collection, and for dumping. */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3543 void
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3544 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
3545 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3546 Dynarr_add (mcpros, varaddress);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3547 Dynarr_add (mcpro_names, varname);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3548 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3549
5046
d4f666cda5e6 some random fixups
Ben Wing <ben@xemacs.org>
parents: 5016
diff changeset
3550 const Ascbyte *mcpro_name (int count);
d4f666cda5e6 some random fixups
Ben Wing <ben@xemacs.org>
parents: 5016
diff changeset
3551
4934
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3552 /* 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
3553 COUNT. */
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
3554 const Ascbyte *
4934
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3555 mcpro_name (int count)
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3556 {
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3557 return Dynarr_at (mcpro_names, count);
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3558 }
714f7c9fabb1 make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents: 4880
diff changeset
3559
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3560 #else /* not DEBUG_XEMACS */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3561
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3562 Lisp_Object_dynarr *mcpros;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3563
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3564 /* 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
3565 garbage collection, and for dumping. */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3566 void
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3567 mcpro (Lisp_Object varaddress)
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 Dynarr_add (mcpros, varaddress);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3570 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3571
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3572 #endif /* not DEBUG_XEMACS */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3573 #endif /* NEW_GC */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3574
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3575
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3576 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3577 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
3578 static Bytecount gc_count_string_total_size;
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 617
diff changeset
3579 static Bytecount gc_count_short_string_total_size;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3581 /* static int gc_count_total_records_used, gc_count_records_total_size; */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3584 /* stats on lcrecords in use - kinda kludgy */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3585
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3586 static struct
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 int instances_in_use;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3589 int bytes_in_use;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3590 int instances_freed;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3591 int bytes_freed;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3592 int instances_on_free_list;
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3593 int bytes_on_free_list;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3594 } lrecord_stats [countof (lrecord_implementations_table)];
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3595
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3596 void
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3597 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
3598 enum lrecord_alloc_status status)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3599 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 617
diff changeset
3600 int type_index = h->type;
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3601 Bytecount sz = detagged_lisp_object_size (h);
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3602
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3603 switch (status)
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3604 {
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3605 case ALLOC_IN_USE:
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3606 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
3607 lrecord_stats[type_index].bytes_in_use += sz;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3608 break;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3609 case ALLOC_FREE:
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3610 lrecord_stats[type_index].instances_freed++;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3611 lrecord_stats[type_index].bytes_freed += sz;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3612 break;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3613 case ALLOC_ON_FREE_LIST:
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3614 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
3615 lrecord_stats[type_index].bytes_on_free_list += sz;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3616 break;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3617 default:
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3618 ABORT ();
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3619 }
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3620 }
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3621
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3622 inline static void
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3623 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
3624 {
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5127
diff changeset
3625 if (h->free)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3626 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3627 gc_checking_assert (!free_p);
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3628 tick_lrecord_stats (h, ALLOC_ON_FREE_LIST);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3629 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3630 else
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3631 tick_lrecord_stats (h, free_p ? ALLOC_FREE : ALLOC_IN_USE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3632 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3633 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3635
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3636 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3637 /* Free all unmarked records */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3638 static void
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
3639 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
3640 {
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
3641 struct old_lcrecord_header *header;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3642 int num_used = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3643 /* int total_size = 0; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3645 /* First go through and call all the finalize methods.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3646 Then go through and free the objects. There used to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3647 be only one loop here, with the call to the finalizer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3648 occurring directly before the xfree() below. That
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3649 is marginally faster but much less safe -- if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3650 finalize method for an object needs to reference any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3651 other objects contained within it (and many do),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3652 we could easily be screwed by having already freed that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3653 other object. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3655 for (header = *prev; header; header = header->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3656 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3657 struct lrecord_header *h = &(header->lheader);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3658
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3659 GC_CHECK_LHEADER_INVARIANTS (h);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3660
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5127
diff changeset
3661 if (! MARKED_RECORD_HEADER_P (h) && !h->free)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3662 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3663 if (LHEADER_IMPLEMENTATION (h)->finalizer)
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
3664 LHEADER_IMPLEMENTATION (h)->finalizer (wrap_pointer_1 (h));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3665 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3666 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3667
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3668 for (header = *prev; header; )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3669 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3670 struct lrecord_header *h = &(header->lheader);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3671 if (MARKED_RECORD_HEADER_P (h))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3672 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3673 if (! C_READONLY_RECORD_HEADER_P (h))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3674 UNMARK_RECORD_HEADER (h);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3675 num_used++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3676 /* total_size += n->implementation->size_in_bytes (h);*/
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3677 /* #### May modify header->next on a C_READONLY lcrecord */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3678 prev = &(header->next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3679 header = *prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3680 tick_lcrecord_stats (h, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3681 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3682 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3683 {
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
3684 struct old_lcrecord_header *next = header->next;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3685 *prev = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3686 tick_lcrecord_stats (h, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3687 /* used to call finalizer right here. */
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4969
diff changeset
3688 xfree (header);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3689 header = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3690 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3691 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3692 *used = num_used;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3693 /* *total = total_size; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3694 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3695
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3696 /* And the Lord said: Thou shalt use the `c-backslash-region' command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3697 to make macros prettier. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3698
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3699 #define COUNT_FROB_BLOCK_USAGE(type) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3700 EMACS_INT s = 0; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3701 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
3702 while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3703 DO_NOTHING
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3704
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3705 #define COPY_INTO_LRECORD_STATS(type) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3706 do { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3707 COUNT_FROB_BLOCK_USAGE (type); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3708 lrecord_stats[lrecord_type_##type].bytes_in_use += s; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3709 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
3710 gc_count_num_##type##_freelist; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3711 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
3712 gc_count_num_##type##_in_use; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3713 } while (0)
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3714
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3715 #ifdef ERROR_CHECK_GC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3716
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3717 #define SWEEP_FIXED_TYPE_BLOCK_1(typename, obj_type, lheader) \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3718 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3719 struct typename##_block *SFTB_current; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3720 int SFTB_limit; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3721 int num_free = 0, num_used = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3722 \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3723 for (SFTB_current = current_##typename##_block, \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3724 SFTB_limit = current_##typename##_block_index; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3725 SFTB_current; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3726 ) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3727 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3728 int SFTB_iii; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3729 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3730 for (SFTB_iii = 0; SFTB_iii < SFTB_limit; SFTB_iii++) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3731 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3732 obj_type *SFTB_victim = &(SFTB_current->block[SFTB_iii]); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3733 \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
3734 if (LRECORD_FREE_P (SFTB_victim)) \
428
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 num_free++; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3737 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3738 else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader)) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3739 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3740 num_used++; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3741 } \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3742 else if (! MARKED_RECORD_HEADER_P (&SFTB_victim->lheader)) \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3743 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3744 num_free++; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3745 FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \
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 else \
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 num_used++; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3750 UNMARK_##typename (SFTB_victim); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3751 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3752 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3753 SFTB_current = SFTB_current->prev; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3754 SFTB_limit = countof (current_##typename##_block->block); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3755 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3756 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3757 gc_count_num_##typename##_in_use = num_used; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3758 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
3759 COPY_INTO_LRECORD_STATS (typename); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3760 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3761
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3762 #else /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3763
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3764 #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
3765 do { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3766 struct typename##_block *SFTB_current; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3767 struct typename##_block **SFTB_prev; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3768 int SFTB_limit; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3769 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
3770 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3771 typename##_free_list = 0; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3772 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3773 for (SFTB_prev = &current_##typename##_block, \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3774 SFTB_current = current_##typename##_block, \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3775 SFTB_limit = current_##typename##_block_index; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3776 SFTB_current; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3777 ) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3778 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3779 int SFTB_iii; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3780 int SFTB_empty = 1; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3781 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
3782 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3783 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
3784 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3785 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
3786 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3787 if (LRECORD_FREE_P (SFTB_victim)) \
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 num_free++; \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3790 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
3791 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3792 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
3793 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3794 SFTB_empty = 0; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3795 num_used++; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3796 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3797 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
3798 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3799 num_free++; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3800 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
3801 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3802 else \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3803 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3804 SFTB_empty = 0; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3805 num_used++; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3806 UNMARK_##typename (SFTB_victim); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3807 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3808 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3809 if (!SFTB_empty) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3810 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3811 SFTB_prev = &(SFTB_current->prev); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3812 SFTB_current = SFTB_current->prev; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3813 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3814 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
3815 && !SFTB_current->prev) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3816 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3817 /* 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
3818 break; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3819 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3820 else \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3821 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3822 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
3823 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
3824 current_##typename##_block_index \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3825 = countof (current_##typename##_block->block); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3826 SFTB_current = SFTB_current->prev; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3827 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3828 *SFTB_prev = SFTB_current; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3829 xfree (SFTB_victim_block); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3830 /* 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
3831 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
3832 num_free -= SFTB_limit; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3833 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3834 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3835 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
3836 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3837 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3838 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
3839 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
3840 COPY_INTO_LRECORD_STATS (typename); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3841 } while (0)
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 #endif /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3844
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3845 #define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type) \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
3846 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
3847
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3848 #endif /* not NEW_GC */
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3849
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3850
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3851 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3852 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3853 sweep_conses (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3854 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3855 #define UNMARK_cons(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3856 #define ADDITIONAL_FREE_cons(ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3857
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3858 SWEEP_FIXED_TYPE_BLOCK (cons, Lisp_Cons);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3859 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3860 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3861
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3862 /* Explicitly free a cons cell. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3863 void
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3864 free_cons (Lisp_Object cons)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3865 {
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3866 #ifndef NEW_GC /* to avoid compiler warning */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3867 Lisp_Cons *ptr = XCONS (cons);
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3868 #endif /* not NEW_GC */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3869
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3870 #ifdef ERROR_CHECK_GC
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3871 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
3872 Lisp_Cons *ptr = XCONS (cons);
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3873 #endif /* NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3874 /* 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
3875 always be four-byte aligned. If this cons cell has already been
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3876 placed on the free list, however, its car will probably contain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3877 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
3878 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
3879 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
3880
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
3881 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
3882 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
3883 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
3884 if (POINTER_TYPE_P (XTYPE (cons_car (ptr))))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3885 ASSERT_VALID_POINTER (XPNTR (cons_car (ptr)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3886 #endif /* ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3887
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
3888 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
3889 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3890
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3891 /* explicitly free a list. You **must make sure** that you have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3892 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
3893 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
3894 are, you will lose. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3895
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3896 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3897 free_list (Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3898 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3899 Lisp_Object rest, next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3900
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3901 for (rest = list; !NILP (rest); rest = next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3902 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3903 next = XCDR (rest);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3904 free_cons (rest);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3905 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3906 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3907
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3908 /* explicitly free an alist. You **must make sure** that you have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3909 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
3910 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
3911 are, you will lose. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3912
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3913 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3914 free_alist (Lisp_Object alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3915 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3916 Lisp_Object rest, next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3917
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3918 for (rest = alist; !NILP (rest); rest = next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3919 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3920 next = XCDR (rest);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3921 free_cons (XCAR (rest));
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3922 free_cons (rest);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3923 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3924 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3925
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
3926 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3927 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3928 sweep_compiled_functions (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3929 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3930 #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
3931 #define ADDITIONAL_FREE_compiled_function(ptr) \
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4969
diff changeset
3932 if (ptr->args_in_array) xfree (ptr->args)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3933
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3934 SWEEP_FIXED_TYPE_BLOCK (compiled_function, Lisp_Compiled_Function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3935 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3936
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3937 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3938 sweep_floats (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3939 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3940 #define UNMARK_float(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3941 #define ADDITIONAL_FREE_float(ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3942
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3943 SWEEP_FIXED_TYPE_BLOCK (float, Lisp_Float);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3944 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3945
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3946 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3947 static void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3948 sweep_bignums (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3949 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3950 #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
3951 #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
3952
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3953 SWEEP_FIXED_TYPE_BLOCK (bignum, Lisp_Bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3954 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3955 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3956
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3957 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3958 static void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3959 sweep_ratios (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3960 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3961 #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
3962 #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
3963
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3964 SWEEP_FIXED_TYPE_BLOCK (ratio, Lisp_Ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3965 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3966 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3967
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3968 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3969 static void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3970 sweep_bigfloats (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3971 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3972 #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
3973 #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
3974
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3975 SWEEP_FIXED_TYPE_BLOCK (bigfloat, Lisp_Bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3976 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3977 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
3978
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3979 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3980 sweep_symbols (void)
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 #define UNMARK_symbol(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3983 #define ADDITIONAL_FREE_symbol(ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3984
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3985 SWEEP_FIXED_TYPE_BLOCK (symbol, Lisp_Symbol);
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3988 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3989 sweep_extents (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3990 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3991 #define UNMARK_extent(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3992 #define ADDITIONAL_FREE_extent(ptr)
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 SWEEP_FIXED_TYPE_BLOCK (extent, struct extent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3995 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3996
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3997 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3998 sweep_events (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3999 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4000 #define UNMARK_event(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4001 #define ADDITIONAL_FREE_event(ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4002
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4003 SWEEP_FIXED_TYPE_BLOCK (event, Lisp_Event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4004 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4005 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4006
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4007 #ifdef EVENT_DATA_AS_OBJECTS
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4008
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4009 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4010 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4011 sweep_key_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4012 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4013 #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
4014 #define ADDITIONAL_FREE_key_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4015
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4016 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
4017 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4018 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4019
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4020 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4021 free_key_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4022 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4023 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
4024 XKEY_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4025 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4026
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4027 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4028 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4029 sweep_button_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4030 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4031 #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
4032 #define ADDITIONAL_FREE_button_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4033
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4034 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
4035 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4036 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4037
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4038 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4039 free_button_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4040 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4041 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
4042 XBUTTON_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4043 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4044
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4045 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4046 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4047 sweep_motion_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4048 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4049 #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
4050 #define ADDITIONAL_FREE_motion_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4051
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4052 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
4053 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4054 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4055
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4056 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4057 free_motion_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4058 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4059 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
4060 XMOTION_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4061 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4062
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4063 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4064 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4065 sweep_process_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4066 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4067 #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
4068 #define ADDITIONAL_FREE_process_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4069
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4070 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
4071 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4072 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4073
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4074 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4075 free_process_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4076 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4077 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
4078 XPROCESS_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4079 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4080
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4081 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4082 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4083 sweep_timeout_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4084 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4085 #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
4086 #define ADDITIONAL_FREE_timeout_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4087
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4088 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
4089 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4090 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4091
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4092 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4093 free_timeout_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4094 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4095 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
4096 XTIMEOUT_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4097 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4098
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4099 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4100 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4101 sweep_magic_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4102 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4103 #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
4104 #define ADDITIONAL_FREE_magic_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4105
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4106 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
4107 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4108 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4109
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4110 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4111 free_magic_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4112 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4113 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
4114 XMAGIC_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4115 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4116
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4117 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4118 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4119 sweep_magic_eval_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4120 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4121 #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
4122 #define ADDITIONAL_FREE_magic_eval_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4123
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4124 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
4125 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4126 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4127
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4128 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4129 free_magic_eval_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4130 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4131 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
4132 XMAGIC_EVAL_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4133 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4134
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4135 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4136 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4137 sweep_eval_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4138 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4139 #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
4140 #define ADDITIONAL_FREE_eval_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4141
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4142 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
4143 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4144 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4145
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4146 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4147 free_eval_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4148 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4149 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
4150 XEVAL_DATA (ptr));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4151 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4152
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4153 #ifndef NEW_GC
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4154 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4155 sweep_misc_user_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4156 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4157 #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
4158 #define ADDITIONAL_FREE_misc_user_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4159
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4160 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
4161 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4162 #endif /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4163
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4164 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4165 free_misc_user_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4166 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4167 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
4168 XMISC_USER_DATA (ptr));
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4169 }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4170
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4171 #endif /* EVENT_DATA_AS_OBJECTS */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4172
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4173 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4174 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4175 sweep_markers (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4176 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4177 #define UNMARK_marker(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4178 #define ADDITIONAL_FREE_marker(ptr) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4179 do { Lisp_Object tem; \
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4180 tem = wrap_marker (ptr); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4181 unchain_marker (tem); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4182 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4183
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4184 SWEEP_FIXED_TYPE_BLOCK (marker, Lisp_Marker);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4185 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4186 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4188 /* Explicitly free a marker. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4189 void
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4190 free_marker (Lisp_Object ptr)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4191 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4192 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
4193 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4194
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4196 #if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4198 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4199 verify_string_chars_integrity (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4200 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4201 struct string_chars_block *sb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4203 /* Scan each existing string block sequentially, string by string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4204 for (sb = first_string_chars_block; sb; sb = sb->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4205 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4206 int pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4207 /* POS is the index of the next string in the block. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4208 while (pos < sb->pos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4209 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4210 struct string_chars *s_chars =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4211 (struct string_chars *) &(sb->string_chars[pos]);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
4212 Lisp_String *string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4213 int size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4214 int fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4215
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4216 /* 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
4217 STRING pointer is NULL) then this is an unused chunk of
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4218 string storage. (See below.) */
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4219
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4220 if (STRING_CHARS_FREE_P (s_chars))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4221 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4222 fullsize = ((struct unused_string_chars *) s_chars)->fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4223 pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4224 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4225 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4227 string = s_chars->string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4228 /* Must be 32-bit aligned. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4229 assert ((((int) string) & 3) == 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4230
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4231 size = string->size_;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4232 fullsize = STRING_FULLSIZE (size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4234 assert (!BIG_STRING_FULLSIZE_P (fullsize));
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4235 assert (XSTRING_DATA (string) == s_chars->chars);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4236 pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4237 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4238 assert (pos == sb->pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4239 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4240 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4241
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4242 #endif /* defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4243
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4244 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4245 /* Compactify string chars, relocating the reference to each --
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4246 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
4247 static void
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4248 compact_string_chars (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4249 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4250 struct string_chars_block *to_sb = first_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4251 int to_pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4252 struct string_chars_block *from_sb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4254 /* Scan each existing string block sequentially, string by string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4255 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
4256 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4257 int from_pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4258 /* FROM_POS is the index of the next string in the block. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4259 while (from_pos < from_sb->pos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4260 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4261 struct string_chars *from_s_chars =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4262 (struct string_chars *) &(from_sb->string_chars[from_pos]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4263 struct string_chars *to_s_chars;
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
4264 Lisp_String *string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4265 int size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4266 int fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4267
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4268 /* 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
4269 STRING pointer is NULL) then this is an unused chunk of
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4270 string storage. This happens under Mule when a string's
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4271 size changes in such a way that its fullsize changes.
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4272 (Strings can change size because a different-length
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4273 character can be substituted for another character.)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4274 In this case, after the bogus string pointer is the
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4275 "fullsize" of this entry, i.e. how many bytes to skip. */
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4276
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 452
diff changeset
4277 if (STRING_CHARS_FREE_P (from_s_chars))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4278 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4279 fullsize = ((struct unused_string_chars *) from_s_chars)->fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4280 from_pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4281 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4282 }
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 string = from_s_chars->string;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4285 gc_checking_assert (!(LRECORD_FREE_P (string)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4286
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4287 size = string->size_;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4288 fullsize = STRING_FULLSIZE (size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4289
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4290 gc_checking_assert (! BIG_STRING_FULLSIZE_P (fullsize));
428
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 /* 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
4293 if (! MARKED_RECORD_HEADER_P (&(string->u.lheader)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4294 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4295 from_pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4296 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4297 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4299 /* 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
4300 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
4301 cannot advance past FROM_SB here since FROM_SB is large enough
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4302 to currently contain this string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4303 if ((to_pos + fullsize) > countof (to_sb->string_chars))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4304 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4305 to_sb->pos = to_pos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4306 to_sb = to_sb->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4307 to_pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4308 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4310 /* Compute new address of this string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4311 and update TO_POS for the space being used. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4312 to_s_chars = (struct string_chars *) &(to_sb->string_chars[to_pos]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4314 /* Copy the string_chars to the new place. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4315 if (from_s_chars != to_s_chars)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4316 memmove (to_s_chars, from_s_chars, fullsize);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4318 /* Relocate FROM_S_CHARS's reference */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
4319 set_lispstringp_data (string, &(to_s_chars->chars[0]));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4321 from_pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4322 to_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 }
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 /* Set current to the last string chars block still used and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4327 free any that follow. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4328 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4329 struct string_chars_block *victim;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4331 for (victim = to_sb->next; victim; )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4332 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4333 struct string_chars_block *next = victim->next;
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4969
diff changeset
4334 xfree (victim);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4335 victim = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4336 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4338 current_string_chars_block = to_sb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4339 current_string_chars_block->pos = to_pos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4340 current_string_chars_block->next = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4341 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4342 }
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4343 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4344
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4345 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4346 #if 1 /* Hack to debug missing purecopy's */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4347 static int debug_string_purity;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4349 static void
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4350 debug_string_purity_print (Lisp_Object p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4351 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4352 Charcount i;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
4353 Charcount s = string_char_length (p);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4354 stderr_out ("\"");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4355 for (i = 0; i < s; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4356 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 858
diff changeset
4357 Ichar ch = string_ichar (p, i);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4358 if (ch < 32 || ch >= 126)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4359 stderr_out ("\\%03o", ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4360 else if (ch == '\\' || ch == '\"')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4361 stderr_out ("\\%c", ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4362 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4363 stderr_out ("%c", ch);
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 stderr_out ("\"\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4366 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4367 #endif /* 1 */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4368 #endif /* not NEW_GC */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4369
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4370 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4371 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4372 sweep_strings (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4373 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 617
diff changeset
4374 int num_small_used = 0;
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 617
diff changeset
4375 Bytecount num_small_bytes = 0, num_bytes = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4376 int debug = debug_string_purity;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4377
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4378 #define UNMARK_string(ptr) do { \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4379 Lisp_String *p = (ptr); \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4380 Bytecount size = p->size_; \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4381 UNMARK_RECORD_HEADER (&(p->u.lheader)); \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4382 num_bytes += size; \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4383 if (!BIG_STRING_SIZE_P (size)) \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4384 { \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4385 num_small_bytes += size; \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4386 num_small_used++; \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4387 } \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4388 if (debug) \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4389 debug_string_purity_print (wrap_string (p)); \
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
4390 } while (0)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
4391 #define ADDITIONAL_FREE_string(ptr) do { \
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4392 Bytecount size = ptr->size_; \
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
4393 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
4394 xfree (ptr->data_); \
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
4395 } while (0)
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
4396
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
4397 SWEEP_FIXED_TYPE_BLOCK_1 (string, Lisp_String, u.lheader);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4399 gc_count_num_short_string_in_use = num_small_used;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4400 gc_count_string_total_size = num_bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4401 gc_count_short_string_total_size = num_small_bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4402 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4403 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4404
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4405 #ifndef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4406 void
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4407 gc_sweep_1 (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4408 {
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4409 /* 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
4410 sweeping lcrecords, frob-block lrecords and dumped objects. */
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4411 xzero (lrecord_stats);
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4412
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4413 /* Free all unmarked records. Do this at the very beginning,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4414 before anything else, so that the finalize methods can safely
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4415 examine items in the objects. sweep_lcrecords_1() makes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4416 sure to call all the finalize methods *before* freeing anything,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4417 to complete the safety. */
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 int ignored;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4420 sweep_lcrecords_1 (&all_lcrecords, &ignored);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4421 }
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 compact_string_chars ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4424
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4425 /* Finalize methods below (called through the ADDITIONAL_FREE_foo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4426 macros) must be *extremely* careful to make sure they're not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4427 referencing freed objects. The only two existing finalize
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4428 methods (for strings and markers) pass muster -- the string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4429 finalizer doesn't look at anything but its own specially-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4430 created block, and the marker finalizer only looks at live
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4431 buffers (which will never be freed) and at the markers before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4432 and after it in the chain (which, by induction, will never be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4433 freed because if so, they would have already removed themselves
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4434 from the chain). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4436 /* Put all unmarked strings on free list, free'ing the string chars
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4437 of large unmarked strings */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4438 sweep_strings ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4440 /* Put all unmarked conses on free list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4441 sweep_conses ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4443 /* Free all unmarked compiled-function objects */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4444 sweep_compiled_functions ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4446 /* Put all unmarked floats on free list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4447 sweep_floats ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4448
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4449 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4450 /* Put all unmarked bignums on free list */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4451 sweep_bignums ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4452 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4453
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4454 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4455 /* Put all unmarked ratios on free list */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4456 sweep_ratios ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4457 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4458
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4459 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4460 /* Put all unmarked bigfloats on free list */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4461 sweep_bigfloats ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4462 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4463
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4464 /* Put all unmarked symbols on free list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4465 sweep_symbols ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4467 /* Put all unmarked extents on free list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4468 sweep_extents ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4469
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4470 /* Put all unmarked markers on free list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4471 Dechain each one first from the buffer into which it points. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4472 sweep_markers ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4474 sweep_events ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4475
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4476 #ifdef EVENT_DATA_AS_OBJECTS
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4477 sweep_key_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4478 sweep_button_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4479 sweep_motion_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4480 sweep_process_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4481 sweep_timeout_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4482 sweep_magic_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4483 sweep_magic_eval_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4484 sweep_eval_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
4485 sweep_misc_user_data ();
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
4486 #endif /* EVENT_DATA_AS_OBJECTS */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4487 #endif /* not NEW_GC */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4488
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4489 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4490 #ifdef PDUMP
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4491 pdump_objects_unmark ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4492 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4493 }
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4494 #endif /* not NEW_GC */
428
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 /* Clearing for disksave. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4498 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4499 disksave_object_finalization (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4500 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4501 /* It's important that certain information from the environment not get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4502 dumped with the executable (pathnames, environment variables, etc.).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4503 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
4504 clear some known-to-be-garbage blocks of memory, so that leftover
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4505 results of old evaluation don't look like potential problems.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4506 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
4507 to turn those strings into garbage.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4508 */
428
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 /* Yeah, this list is pretty ad-hoc... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4511 Vprocess_environment = Qnil;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
4512 env_initted = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4513 Vexec_directory = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4514 Vdata_directory = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4515 Vsite_directory = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4516 Vdoc_directory = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4517 Vexec_path = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4518 Vload_path = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4519 /* Vdump_load_path = Qnil; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4520 /* Release hash tables for locate_file */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4521 Flocate_file_clear_hashing (Qt);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
4522 uncache_home_directory ();
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
4523 zero_out_command_line_status_vars ();
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
4524 clear_default_devices ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4525
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4526 #if defined(LOADHIST) && !(defined(LOADHIST_DUMPED) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4527 defined(LOADHIST_BUILTIN))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4528 Vload_history = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4529 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4530 Vshell_file_name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4531
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4532 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4533 gc_full ();
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4534 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4535 garbage_collect_1 ();
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4536 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4537
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4538 /* Run the disksave finalization methods of all live objects. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4539 disksave_object_finalization_1 ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4540
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4541 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4542 /* Zero out the uninitialized (really, unused) part of the containers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4543 for the live strings. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4544 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4545 struct string_chars_block *scb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4546 for (scb = first_string_chars_block; scb; scb = scb->next)
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 int count = sizeof (scb->string_chars) - scb->pos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4550 assert (count >= 0 && count < STRING_CHARS_BLOCK_SIZE);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4551 if (count != 0)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4552 {
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4553 /* from the block's fill ptr to the end */
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4554 memset ((scb->string_chars + scb->pos), 0, count);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4555 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4556 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4557 }
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4558 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4560 /* There, that ought to be enough... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4562 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4563
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4564 #ifdef ALLOC_TYPE_STATS
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4565
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4566 static Lisp_Object
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4567 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
4568 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4569 /* 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
4570 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
4571 arrays, or exceptions, or ...) */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4572 return cons3 (intern (name), make_int (value), tail);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4573 }
2775
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani]
crestani
parents: 2720
diff changeset
4574
5058
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4575 /* 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
4576 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
4577 static void
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4578 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
4579 {
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4580 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
4581 int upper = 0;
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4582 Ascbyte d, e;
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4583
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4584 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
4585 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
4586 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
4587 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
4588 upper = isupper (e);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4589 e = tolower (e);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4590 d = tolower (d);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4591 if (e == 'y')
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4592 {
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4593 switch (d)
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4594 {
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4595 case 'a':
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4596 case 'e':
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4597 case 'i':
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4598 case 'o':
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4599 case 'u':
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4600 goto pluralize_s;
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4601 default:
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4602 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
4603 goto pluralize_es;
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4604 }
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4605 }
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4606 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
4607 {
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4608 pluralize_es:
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4609 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
4610 }
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4611 pluralize_s:
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4612 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
4613 buf[len] = '\0';
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4614 return;
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4615
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4616 pluralize_apostrophe_s:
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4617 buf[len++] = '\'';
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4618 goto pluralize_s;
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4619 }
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4620
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4621 static void
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4622 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
4623 {
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4624 strcpy (buf, name);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4625 pluralize_word (buf);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4626 strcat (buf, suffix);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4627 }
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4628
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4629 static Lisp_Object
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4630 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
4631 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4632 Lisp_Object pl = Qnil;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4633 int i;
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4634 EMACS_INT tgu_val = 0;
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4635
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4636 #ifdef NEW_GC
2775
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani]
crestani
parents: 2720
diff changeset
4637
3461
fd2936bbfc5f [xemacs-hg @ 2006-06-19 18:10:17 by james]
james
parents: 3355
diff changeset
4638 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
4639 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4640 if (lrecord_stats[i].instances_in_use != 0)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4641 {
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
4642 Ascbyte buf[255];
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
4643 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
4644
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4645 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
4646 lrecord_stats[i].bytes_in_use)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4647 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4648 sprintf (buf, "%s-storage-including-overhead", name);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4649 pl = gc_plist_hack (buf,
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4650 lrecord_stats[i]
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4651 .bytes_in_use_including_overhead,
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4652 pl);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4653 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4654
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4655 sprintf (buf, "%s-storage", name);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4656 pl = gc_plist_hack (buf,
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4657 lrecord_stats[i].bytes_in_use,
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4658 pl);
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4659 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
4660
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4661 pluralize_and_append (buf, name, "-used");
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4662 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
4663 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
4664 }
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4665
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4666 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4667
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4668 #define HACK_O_MATIC(type, name, pl) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4669 do { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4670 COUNT_FROB_BLOCK_USAGE (type); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4671 tgu_val += s; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4672 (pl) = gc_plist_hack ((name), s, (pl)); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4673 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4674
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4675 #define FROB(type) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4676 do { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4677 COUNT_FROB_BLOCK_USAGE (type); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4678 tgu_val += s; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4679 } while (0)
5058
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 FROB (extent);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4682 FROB (event);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4683 FROB (marker);
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4684 FROB (float);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4685 #ifdef HAVE_BIGNUM
5058
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4686 FROB (bignum);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4687 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4688 #ifdef HAVE_RATIO
5058
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4689 FROB (ratio);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4690 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4691 #ifdef HAVE_BIGFLOAT
5058
eb17f0c176ac clean up a bit the object-memory-usage-stats after gc
Ben Wing <ben@xemacs.org>
parents: 5046
diff changeset
4692 FROB (bigfloat);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
4693 #endif /* HAVE_BIGFLOAT */
5059
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4694 FROB (compiled_function);
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4695 FROB (symbol);
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4696 FROB (cons);
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4697
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4698 #undef FROB
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4699
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4700 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
4701 {
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4702 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
4703 || lrecord_stats[i].bytes_freed != 0
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4704 || 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
4705 {
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4706 Ascbyte buf[255];
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4707 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
4708
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4709 sprintf (buf, "%s-storage", name);
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4710 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
4711 tgu_val += lrecord_stats[i].bytes_in_use;
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4712 pluralize_and_append (buf, name, "-freed");
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4713 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
4714 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
4715 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
4716 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
4717 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
4718 pl);
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4719 pluralize_and_append (buf, name, "-used");
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4720 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
4721 }
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4722 }
c8f90d61dcf3 fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents: 5058
diff changeset
4723
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4724 HACK_O_MATIC (string, "string-header-storage", pl);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4725 pl = gc_plist_hack ("long-strings-total-length",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4726 gc_count_string_total_size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4727 - gc_count_short_string_total_size, pl);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4728 HACK_O_MATIC (string_chars, "short-string-storage", pl);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4729 pl = gc_plist_hack ("short-strings-total-length",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4730 gc_count_short_string_total_size, pl);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4731 pl = gc_plist_hack ("strings-free", gc_count_num_string_freelist, pl);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4732 pl = gc_plist_hack ("long-strings-used",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4733 gc_count_num_string_in_use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4734 - gc_count_num_short_string_in_use, pl);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4735 pl = gc_plist_hack ("short-strings-used",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4736 gc_count_num_short_string_in_use, pl);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4737
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4738 #undef HACK_O_MATIC
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4739
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4740 #endif /* NEW_GC */
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4741
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4742 if (set_total_gc_usage)
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4743 {
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4744 total_gc_usage = tgu_val;
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4745 total_gc_usage_set = 1;
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4746 }
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4747
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4748 return pl;
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4749 }
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4750
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4751 DEFUN("object-memory-usage-stats", Fobject_memory_usage_stats, 0, 0 ,"", /*
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4752 Return statistics about memory usage of Lisp objects.
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4753 */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4754 ())
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4755 {
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4756 return object_memory_usage_stats (0);
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4757 }
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4758
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4759 #endif /* ALLOC_TYPE_STATS */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4760
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4761 /* Debugging aids. */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4762
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4763 DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /*
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4764 Reclaim storage for Lisp objects no longer needed.
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4765 Return info on amount of space in use:
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4766 ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4767 (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
4768 PLIST)
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4769 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
4770 more detailed information.
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4771 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
4772 `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
4773 */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4774 ())
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4775 {
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4776 /* 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
4777 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4778 gc_full ();
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4779 #else /* not NEW_GC */
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4780 garbage_collect_1 ();
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
4781 #endif /* not NEW_GC */
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4782
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4783 /* 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
4784 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
4785 total_gc_usage_set = 0;
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4786 #ifdef ALLOC_TYPE_STATS
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4787 /* The things we do for backwards-compatibility */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4788 #ifdef NEW_GC
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4789 return
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4790 list6
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4791 (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
4792 make_int (lrecord_stats[lrecord_type_cons]
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4793 .bytes_in_use_including_overhead)),
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4794 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
4795 make_int (lrecord_stats[lrecord_type_symbol]
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4796 .bytes_in_use_including_overhead)),
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4797 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
4798 make_int (lrecord_stats[lrecord_type_marker]
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4799 .bytes_in_use_including_overhead)),
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4800 make_int (lrecord_stats[lrecord_type_string]
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4801 .bytes_in_use_including_overhead),
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4802 make_int (lrecord_stats[lrecord_type_vector]
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4803 .bytes_in_use_including_overhead),
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4804 object_memory_usage_stats (1));
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4805 #else /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4806 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4807 list6 (Fcons (make_int (gc_count_num_cons_in_use),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4808 make_int (gc_count_num_cons_freelist)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4809 Fcons (make_int (gc_count_num_symbol_in_use),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4810 make_int (gc_count_num_symbol_freelist)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4811 Fcons (make_int (gc_count_num_marker_in_use),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4812 make_int (gc_count_num_marker_freelist)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4813 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
4814 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
4815 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
4816 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
4817 object_memory_usage_stats (1));
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
4818 #endif /* not NEW_GC */
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4819 #else /* not ALLOC_TYPE_STATS */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4820 return Qnil;
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4821 #endif /* ALLOC_TYPE_STATS */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4822 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4824 DEFUN ("consing-since-gc", Fconsing_since_gc, 0, 0, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4825 Return the number of bytes consed since the last garbage collection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4826 \"Consed\" is a misnomer in that this actually counts allocation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4827 of all different kinds of objects, not just conses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4828
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4829 If this value exceeds `gc-cons-threshold', a garbage collection happens.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4830 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4831 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4832 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4833 return make_int (consing_since_gc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4834 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4835
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4836 #if 0
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4837 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
4838 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
4839 This may be helpful in debugging XEmacs's memory usage.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4840 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
4841 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4842 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4843 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4844 return make_int ((EMACS_INT) sbrk (0) / 1024);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4845 }
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
4846 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4847
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4848 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
4849 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
4850 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
4851 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
4852 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
4853 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
4854 */
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
4855 ())
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
4856 {
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
4857 return make_int (total_data_usage ());
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
4858 }
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
4859
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4860 #ifdef ALLOC_TYPE_STATS
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4861 DEFUN ("object-memory-usage", Fobject_memory_usage, 0, 0, 0, /*
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4862 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
4863 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
4864 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
4865 */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4866 ())
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4867 {
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4868 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
4869 }
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4870 #endif /* ALLOC_TYPE_STATS */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
4871
4803
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4872 #ifdef USE_VALGRIND
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4873 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
4874 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
4875 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
4876 */
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4877 ())
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4878 {
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4879 VALGRIND_DO_LEAK_CHECK;
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4880 return Qnil;
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4881 }
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4882
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4883 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
4884 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
4885 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
4886 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
4887 */
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4888 ())
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4889 {
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4890 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
4891 return Qnil;
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4892 }
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4893 #endif /* USE_VALGRIND */
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
4894
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
4895 void
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
4896 recompute_funcall_allocation_flag (void)
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
4897 {
887
ccc3177ef10b [xemacs-hg @ 2002-06-28 14:21:41 by michaels]
michaels
parents: 872
diff changeset
4898 funcall_allocation_flag =
ccc3177ef10b [xemacs-hg @ 2002-06-28 14:21:41 by michaels]
michaels
parents: 872
diff changeset
4899 need_to_garbage_collect ||
ccc3177ef10b [xemacs-hg @ 2002-06-28 14:21:41 by michaels]
michaels
parents: 872
diff changeset
4900 need_to_check_c_alloca ||
ccc3177ef10b [xemacs-hg @ 2002-06-28 14:21:41 by michaels]
michaels
parents: 872
diff changeset
4901 need_to_signal_post_gc;
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
4902 }
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
4903
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4904
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4905 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4906 object_dead_p (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4907 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4908 return ((BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj))) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4909 (FRAMEP (obj) && !FRAME_LIVE_P (XFRAME (obj))) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4910 (WINDOWP (obj) && !WINDOW_LIVE_P (XWINDOW (obj))) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4911 (DEVICEP (obj) && !DEVICE_LIVE_P (XDEVICE (obj))) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4912 (CONSOLEP (obj) && !CONSOLE_LIVE_P (XCONSOLE (obj))) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4913 (EVENTP (obj) && !EVENT_LIVE_P (XEVENT (obj))) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4914 (EXTENTP (obj) && !EXTENT_LIVE_P (XEXTENT (obj))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4915 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4916
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4917 #ifdef MEMORY_USAGE_STATS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4919 /* Attempt to determine the actual amount of space that is used for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4920 the block allocated starting at PTR, supposedly of size "CLAIMED_SIZE".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4921
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4922 It seems that the following holds:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4923
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4924 1. When using the old allocator (malloc.c):
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4925
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4926 -- blocks are always allocated in chunks of powers of two. For
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4927 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
4928 defined, 20 bytes if it is defined. In other words, a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4929 one-byte allocation needs 8 bytes of overhead for a total of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4930 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
4931 it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4932
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4933 2. When using the new allocator (gmalloc.c):
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4934
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4935 -- blocks are always allocated in chunks of powers of two up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4936 to 4096 bytes. Larger blocks are allocated in chunks of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4937 an integral multiple of 4096 bytes. The minimum block
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4938 size is 2*sizeof (void *), or 16 bytes if SUNOS_LOCALTIME_BUG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4939 is defined. There is no per-block overhead, but there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4940 is an overhead of 3*sizeof (size_t) for each 4096 bytes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4941 allocated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4942
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4943 3. When using the system malloc, anything goes, but they are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4944 generally slower and more space-efficient than the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4945 allocators. One possibly reasonable assumption to make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4946 for want of better data is that sizeof (void *), or maybe
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4947 2 * sizeof (void *), is required as overhead and that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4948 blocks are allocated in the minimum required size except
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4949 that some minimum block size is imposed (e.g. 16 bytes). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4950
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
4951 Bytecount
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
4952 malloced_storage_size (void * UNUSED (ptr), Bytecount claimed_size,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4953 struct overhead_stats *stats)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4954 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
4955 Bytecount orig_claimed_size = claimed_size;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4956
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
4957 #ifndef SYSTEM_MALLOC
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
4958 if (claimed_size < (Bytecount) (2 * sizeof (void *)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4959 claimed_size = 2 * sizeof (void *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4960 # ifdef SUNOS_LOCALTIME_BUG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4961 if (claimed_size < 16)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4962 claimed_size = 16;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4963 # endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4964 if (claimed_size < 4096)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4965 {
2260
f913c1545598 [xemacs-hg @ 2004-09-10 18:46:58 by james]
james
parents: 1983
diff changeset
4966 /* 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
4967 int log2 = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4968
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4969 /* 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
4970 the block size needed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4971 claimed_size--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4972 /* It's big, it's heavy, it's wood! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4973 while ((claimed_size /= 2) != 0)
2260
f913c1545598 [xemacs-hg @ 2004-09-10 18:46:58 by james]
james
parents: 1983
diff changeset
4974 ++log2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4975 claimed_size = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4976 /* 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
4977 while (log2 > 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4978 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4979 claimed_size *= 2;
2260
f913c1545598 [xemacs-hg @ 2004-09-10 18:46:58 by james]
james
parents: 1983
diff changeset
4980 log2--;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4981 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4982 /* We have to come up with some average about the amount of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4983 blocks used. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
4984 if ((Bytecount) (rand () & 4095) < claimed_size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4985 claimed_size += 3 * sizeof (void *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4986 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4987 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4988 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4989 claimed_size += 4095;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4990 claimed_size &= ~4095;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4991 claimed_size += (claimed_size / 4096) * 3 * sizeof (size_t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4992 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4993
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
4994 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4995
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4996 if (claimed_size < 16)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4997 claimed_size = 16;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4998 claimed_size += 2 * sizeof (void *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4999
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
5000 #endif /* system allocator */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5002 if (stats)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5003 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5004 stats->was_requested += orig_claimed_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5005 stats->malloc_overhead += claimed_size - orig_claimed_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5006 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5007 return claimed_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5008 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5009
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5010 #ifndef NEW_GC
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
5011 Bytecount
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
5012 fixed_type_block_overhead (Bytecount size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5013 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
5014 Bytecount per_block = TYPE_ALLOC_SIZE (cons, unsigned char);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
5015 Bytecount overhead = 0;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
5016 Bytecount storage_size = malloced_storage_size (0, per_block, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5017 while (size >= per_block)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5018 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5019 size -= per_block;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5020 overhead += sizeof (void *) + per_block - storage_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5021 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5022 if (rand () % per_block < size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5023 overhead += sizeof (void *) + per_block - storage_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5024 return overhead;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5025 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5026 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5027 #endif /* MEMORY_USAGE_STATS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5028
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5029
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5030 /* Initialization */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5031 static void
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5032 common_init_alloc_early (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5033 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5034 #ifndef Qzero
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5035 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
5036 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5037
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5038 #ifndef Qnull_pointer
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5039 /* 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
5040 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
5041 Qnull_pointer = wrap_pointer_1 (0);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5042 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5043
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5044 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5045 breathing_space = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5046 all_lcrecords = 0;
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5047 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5048 ignore_malloc_warnings = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5049 #ifdef DOUG_LEA_MALLOC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5050 mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5051 mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5052 #if 0 /* Moved to emacs.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5053 mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5054 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5055 #endif
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
5056 #ifndef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5057 init_string_chars_alloc ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5058 init_string_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5059 init_string_chars_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5060 init_cons_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5061 init_symbol_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5062 init_compiled_function_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5063 init_float_alloc ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5064 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5065 init_bignum_alloc ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5066 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5067 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5068 init_ratio_alloc ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5069 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5070 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5071 init_bigfloat_alloc ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1957
diff changeset
5072 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5073 init_marker_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5074 init_extent_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5075 init_event_alloc ();
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5076 #ifdef EVENT_DATA_AS_OBJECTS
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5077 init_key_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5078 init_button_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5079 init_motion_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5080 init_process_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5081 init_timeout_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5082 init_magic_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5083 init_magic_eval_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5084 init_eval_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 887
diff changeset
5085 init_misc_user_data_alloc ();
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5086 #endif /* EVENT_DATA_AS_OBJECTS */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5087 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5089 ignore_malloc_warnings = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5090
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
5091 if (staticpros_nodump)
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
5092 Dynarr_free (staticpros_nodump);
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
5093 staticpros_nodump = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
5094 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
5095 #ifdef DEBUG_XEMACS
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5096 if (staticpro_nodump_names)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5097 Dynarr_free (staticpro_nodump_names);
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
5098 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
5099 const Ascbyte *);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5100 Dynarr_resize (staticpro_nodump_names, 100); /* ditto */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5101 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5102
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5103 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5104 mcpros = Dynarr_new2 (Lisp_Object_dynarr, Lisp_Object);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5105 Dynarr_resize (mcpros, 1410); /* merely a small optimization */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5106 dump_add_root_block_ptr (&mcpros, &mcpros_description);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5107 #ifdef DEBUG_XEMACS
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
5108 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
5109 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
5110 dump_add_root_block_ptr (&mcpro_names,
4964
1f509f82c8c9 fix compile error
Ben Wing <ben@xemacs.org>
parents: 4962
diff changeset
5111 &const_Ascbyte_ptr_dynarr_description);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5112 #endif
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5113 #endif /* NEW_GC */
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5114
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5115 consing_since_gc = 0;
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
5116 need_to_check_c_alloca = 0;
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
5117 funcall_allocation_flag = 0;
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
5118 funcall_alloca_count = 0;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
5119
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5120 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5121 debug_string_purity = 0;
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5122 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5123
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
5124 #ifdef ERROR_CHECK_TYPES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5125 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
5126 666;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5127 ERROR_ME_NOT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5128 really_unlikely_name_to_have_accidentally_in_a_non_errb_structure = 42;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5129 ERROR_ME_WARN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5130 really_unlikely_name_to_have_accidentally_in_a_non_errb_structure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5131 3333632;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
5132 ERROR_ME_DEBUG_WARN.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
5133 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
5134 8675309;
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
5135 #endif /* ERROR_CHECK_TYPES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5136 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5137
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5138 #ifndef NEW_GC
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5139 static void
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5140 init_lcrecord_lists (void)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5141 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5142 int i;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5143
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5144 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
5145 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5146 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
5147 staticpro_nodump (&all_lcrecord_lists[i]);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5148 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5149 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5150 #endif /* not NEW_GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5151
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5152 void
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5153 init_alloc_early (void)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5154 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5155 #if defined (__cplusplus) && defined (ERROR_CHECK_GC)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5156 static struct gcpro initial_gcpro;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5157
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5158 initial_gcpro.next = 0;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5159 initial_gcpro.var = &Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5160 initial_gcpro.nvars = 1;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5161 gcprolist = &initial_gcpro;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5162 #else
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5163 gcprolist = 0;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5164 #endif /* defined (__cplusplus) && defined (ERROR_CHECK_GC) */
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5165 }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5166
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5167 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5168 reinit_alloc_early (void)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5169 {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5170 common_init_alloc_early ();
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5171 #ifndef NEW_GC
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5172 init_lcrecord_lists ();
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5173 #endif /* not NEW_GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5174 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5175
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5176 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5177 init_alloc_once_early (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5178 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1154
diff changeset
5179 common_init_alloc_early ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5180
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5181 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5182 int i;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5183 for (i = 0; i < countof (lrecord_implementations_table); i++)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5184 lrecord_implementations_table[i] = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5185 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5186
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
5187 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
5188
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
5189 INIT_LISP_OBJECT (cons);
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
5190 INIT_LISP_OBJECT (vector);
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
5191 INIT_LISP_OBJECT (string);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
5192 #ifdef NEW_GC
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4776
diff changeset
5193 INIT_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
5194 INIT_LISP_OBJECT (string_direct_data);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3063
diff changeset
5195 #endif /* NEW_GC */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5196 #ifndef NEW_GC
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
5197 INIT_LISP_OBJECT (lcrecord_list);
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3063
diff changeset
5198 INIT_LISP_OBJECT (free);
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5199 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5200
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
5201 staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
5202 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
5203 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
5204 #ifdef DEBUG_XEMACS
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
5205 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
5206 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
5207 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
5208 &const_Ascbyte_ptr_dynarr_description);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5209 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5210
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5211 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5212 mcpros = Dynarr_new2 (Lisp_Object_dynarr, Lisp_Object);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5213 Dynarr_resize (mcpros, 1410); /* merely a small optimization */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5214 dump_add_root_block_ptr (&mcpros, &mcpros_description);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5215 #ifdef DEBUG_XEMACS
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4938
diff changeset
5216 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
5217 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
5218 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
5219 &const_Ascbyte_ptr_dynarr_description);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2666
diff changeset
5220 #endif
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5221 #else /* not NEW_GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
5222 init_lcrecord_lists ();
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3176
diff changeset
5223 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5224 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5226 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5227 syms_of_alloc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5228 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5229 DEFSYMBOL (Qgarbage_collecting);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5231 DEFSUBR (Fcons);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5232 DEFSUBR (Flist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5233 DEFSUBR (Fvector);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5234 DEFSUBR (Fbit_vector);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5235 DEFSUBR (Fmake_byte_code);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5236 DEFSUBR (Fmake_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5237 DEFSUBR (Fmake_vector);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5238 DEFSUBR (Fmake_bit_vector);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5239 DEFSUBR (Fmake_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5240 DEFSUBR (Fstring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5241 DEFSUBR (Fmake_symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5242 DEFSUBR (Fmake_marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5243 DEFSUBR (Fpurecopy);
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5244 #ifdef ALLOC_TYPE_STATS
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5245 DEFSUBR (Fobject_memory_usage_stats);
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5246 DEFSUBR (Fobject_memory_usage);
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5247 #endif /* ALLOC_TYPE_STATS */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5248 DEFSUBR (Fgarbage_collect);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
5249 #if 0
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5250 DEFSUBR (Fmemory_limit);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
5251 #endif
2994
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben]
ben
parents: 2971
diff changeset
5252 DEFSUBR (Ftotal_memory_usage);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5253 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
5254 #ifdef USE_VALGRIND
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5255 DEFSUBR (Fvalgrind_leak_check);
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind
Jerry James <james@xemacs.org>
parents: 4776
diff changeset
5256 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
5257 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5258 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5260 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5261 vars_of_alloc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5262 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5263 #ifdef DEBUG_XEMACS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5264 DEFVAR_INT ("debug-allocation", &debug_allocation /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5265 If non-zero, print out information to stderr about all objects allocated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5266 See also `debug-allocation-backtrace-length'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5267 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5268 debug_allocation = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5270 DEFVAR_INT ("debug-allocation-backtrace-length",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5271 &debug_allocation_backtrace_length /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5272 Length (in stack frames) of short backtrace printed out by `debug-allocation'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5273 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5274 debug_allocation_backtrace_length = 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5275 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5277 DEFVAR_BOOL ("purify-flag", &purify_flag /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5278 Non-nil means loading Lisp code in order to dump an executable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5279 This means that certain objects should be allocated in readonly space.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5280 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5281 }