xemacs-beta: src/alloc.c annotate

annotate src/alloc.c @ 5531:1b054bc2ac40

Allow disabling a symbol macro with a macro environment, #'cl-macroexpand 2011-07-03 Aidan Kehoe <kehoea@parhasard.net> * cl.el (cl-macroexpand): Allow code to disable a given symbol macro while expanding code by prepending a cons with a nil cdr to the macro environment.

author	Aidan Kehoe <kehoea@parhasard.net>
date	Sun, 03 Jul 2011 14:17:39 +0100
parents	248176c74e6b
children	58b38d5b32d0

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
5402 308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5229 diff changeset	8 XEmacs is free software: you can redistribute it and/or modify it
428 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
5402 308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5229 diff changeset	10 Free Software Foundation, either version 3 of the License, or (at your
308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5229 diff changeset	11 option) any later version.
428 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
5402 308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5229 diff changeset	19 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	20
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	21 /* Synched up with: FSF 19.28, Mule 2.0. Substantially different from
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	22 FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	23
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	24 /* Authorship:
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 FSF: Original version; a long time ago.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	27 Mly: Significantly rewritten to use new 3-bit tags and
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	28 nicely abstracted object definitions, for 19.8.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	29 JWZ: Improved code to keep track of purespace usage and
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	30 issue nice purespace and GC stats.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	31 Ben Wing: Cleaned up frob-block lrecord code, added error-checking
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	32 and various changes for Mule, for 19.12.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	33 Added bit vectors for 19.13.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	34 Added lcrecord lists for 19.14.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	35 slb: Lots of work on the purification and dump time code.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	36 Synched Doug Lea malloc support from Emacs 20.2.
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	37 og: Killed the purespace. Portable dumper (moved to dumper.c)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	38 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	39
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	40 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	41 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	42
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	43 #include "backtrace.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	44 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	45 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	46 #include "chartab.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	47 #include "device.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	48 #include "elhash.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	49 #include "events.h"
872 79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben] ben parents: 867 diff changeset	50 #include "extents-impl.h"
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	51 #include "file-coding.h"
872 79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben] ben parents: 867 diff changeset	52 #include "frame-impl.h"
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	53 #include "gc.h"
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	54 #include "glyphs.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	55 #include "opaque.h"
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	56 #include "lstream.h"
872 79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben] ben parents: 867 diff changeset	57 #include "process.h"
1292 f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1276 diff changeset	58 #include "profile.h"
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	59 #include "redisplay.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	60 #include "specifier.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	61 #include "sysfile.h"
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	62 #include "sysdep.h"
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	63 #include "window.h"
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	64 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	65 #include "vdb.h"
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	66 #endif /* NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	67 #include "console-stream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	68
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	69 #ifdef DOUG_LEA_MALLOC
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	70 #include <malloc.h>
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	71 #endif
4803 5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	72 #ifdef USE_VALGRIND
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	73 #include <valgrind/memcheck.h>
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	74 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	75
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	76 EXFUN (Fgarbage_collect, 0);
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 #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	79 #if defined(DEBUG_XEMACS) && defined(MULE)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	80 #define VERIFY_STRING_CHARS_INTEGRITY
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	81 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	82 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	83
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	84 /* Define this to use malloc/free with no freelist for all datatypes,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	85 the hope being that some debugging tools may help detect
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	86 freed memory references */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	87 #ifdef USE_DEBUG_MALLOC /* Taking the above comment at face value -slb */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	88 #include <dmalloc.h>
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	89 #define ALLOC_NO_POOLS
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	90 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	91
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	92 #ifdef DEBUG_XEMACS
458 c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	93 static Fixnum debug_allocation;
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	94 static Fixnum debug_allocation_backtrace_length;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	95 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	96
5307 c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	97 Fixnum Varray_dimension_limit, Varray_total_size_limit, Varray_rank_limit;
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	98
851 e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben] ben parents: 826 diff changeset	99 int need_to_check_c_alloca;
887 ccc3177ef10b [xemacs-hg @ 2002-06-28 14:21:41 by michaels] michaels parents: 872 diff changeset	100 int need_to_signal_post_gc;
851 e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben] ben parents: 826 diff changeset	101 int funcall_allocation_flag;
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben] ben parents: 826 diff changeset	102 Bytecount __temp_alloca_size__;
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben] ben parents: 826 diff changeset	103 Bytecount funcall_alloca_count;
814 a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben] ben parents: 801 diff changeset	104
5146 88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	105 /* All the built-in lisp object types are enumerated in `enum lrecord_type'.
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	106 Additional ones may be defined by a module (none yet). We leave some
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	107 room in `lrecord_implementations_table' for such new lisp object types. */
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	108 struct lrecord_implementation *lrecord_implementations_table[(int)lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT];
5146 88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	109 int lrecord_type_count = lrecord_type_last_built_in_type;
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	110
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	111 /* This is just for use by the printer, to allow things to print uniquely.
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	112 We have a separate UID space for each object. (Important because the
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	113 UID is only 20 bits in old-GC, and 22 in NEW_GC.) */
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	114 int lrecord_uid_counter[countof (lrecord_implementations_table)];
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	115
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	116 #ifndef USE_KKCC
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	117 /* Object marker functions are in the lrecord_implementation structure.
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	118 But copying them to a parallel array is much more cache-friendly.
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	119 This hack speeds up (garbage-collect) by about 5%. */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	120 Lisp_Object (*lrecord_markers[countof (lrecord_implementations_table)]) (Lisp_Object);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	121 #endif /* not USE_KKCC */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	122
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	123 struct gcpro *gcprolist;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	124
5146 88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	125 /* Non-zero means we're in the process of doing the dump */
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	126 int purify_flag;
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	127
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	128 /* Non-zero means we're pdumping out or in */
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	129 #ifdef PDUMP
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	130 int in_pdump;
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	131 #endif
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	132
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	133 #ifdef ERROR_CHECK_TYPES
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	134
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	135 Error_Behavior ERROR_ME, ERROR_ME_NOT, ERROR_ME_WARN, ERROR_ME_DEBUG_WARN;
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	136
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	137 #endif
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	138
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	139 #ifdef MEMORY_USAGE_STATS
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	140 Lisp_Object Qobject_actually_requested, Qobject_malloc_overhead;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	141 Lisp_Object Qother_memory_actually_requested, Qother_memory_malloc_overhead;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	142 Lisp_Object Qother_memory_dynarr_overhead, Qother_memory_gap_overhead;
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	143 #endif /* MEMORY_USAGE_STATS */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	144
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	145 #ifndef NEW_GC
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	146 static int gc_count_num_short_string_in_use;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	147 static Bytecount gc_count_string_total_size;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	148 static Bytecount gc_count_short_string_total_size;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	149 static Bytecount gc_count_long_string_storage_including_overhead;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	150 #endif /* not NEW_GC */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	151
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	152 /* static int gc_count_total_records_used, gc_count_records_total_size; */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	153
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	154 /* stats on objects in use */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	155
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	156 #ifdef NEW_GC
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	157
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	158 static struct
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	159 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	160 int instances_in_use;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	161 int bytes_in_use;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	162 int bytes_in_use_including_overhead;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	163 } lrecord_stats [countof (lrecord_implementations_table)];
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	164
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	165 #else /* not NEW_GC */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	166
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	167 static struct
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	168 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	169 Elemcount instances_in_use;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	170 Bytecount bytes_in_use;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	171 Bytecount bytes_in_use_overhead;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	172 Elemcount instances_freed;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	173 Bytecount bytes_freed;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	174 Bytecount bytes_freed_overhead;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	175 Elemcount instances_on_free_list;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	176 Bytecount bytes_on_free_list;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	177 Bytecount bytes_on_free_list_overhead;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	178 #ifdef MEMORY_USAGE_STATS
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	179 Bytecount nonlisp_bytes_in_use;
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	180 Bytecount lisp_ancillary_bytes_in_use;
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	181 struct generic_usage_stats stats;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	182 #endif
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	183 } lrecord_stats [countof (lrecord_implementations_table)];
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	184
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	185 #endif /* (not) NEW_GC */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	186
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	187 /* 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	188 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	189 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	190 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	191
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	192
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	193 /************************************************************************/
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	194 /* Low-level allocation */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	195 /************************************************************************/
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	196
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	197 void
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	198 recompute_funcall_allocation_flag (void)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	199 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	200 funcall_allocation_flag =
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	201 need_to_garbage_collect \|\|
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	202 need_to_check_c_alloca \|\|
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	203 need_to_signal_post_gc;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	204 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	205
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	206 /* Maximum amount of C stack to save when a GC happens. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	207
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	208 #ifndef MAX_SAVE_STACK
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	209 #define MAX_SAVE_STACK 0 /* 16000 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	210 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	211
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	212 /* Non-zero means ignore malloc warnings. Set during initialization. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	213 int ignore_malloc_warnings;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	214
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	215
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	216 #ifndef NEW_GC
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	217 void *breathing_space;
428 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 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	220 release_breathing_space (void)
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 if (breathing_space)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	223 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	224 void *tmp = breathing_space;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	225 breathing_space = 0;
4976 16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO) Ben Wing <ben@xemacs.org> parents: 4969 diff changeset	226 xfree (tmp);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	227 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	228 }
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	229
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	230 #if !defined(HAVE_MMAP) \|\| defined(DOUG_LEA_MALLOC)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	231 /* If we released our reserve (due to running out of memory),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	232 and we have a fair amount free once again,
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	233 try to set aside another reserve in case we run out once more.
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	234
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	235 This is called when a relocatable block is freed in ralloc.c. */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	236 void refill_memory_reserve (void);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	237 void
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	238 refill_memory_reserve (void)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	239 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	240 if (breathing_space == 0)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	241 breathing_space = (char *) malloc (4096 - MALLOC_OVERHEAD);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	242 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	243 #endif /* !defined(HAVE_MMAP) \|\| defined(DOUG_LEA_MALLOC) */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	244
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	245 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	246
801 2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	247 static void
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	248 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	249 {
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	250 if (!val)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	251 return;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	252 if ((char ) val + size > (char ) maximum_address_seen)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	253 maximum_address_seen = (char *) val + size;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	254 if (!minimum_address_seen)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	255 minimum_address_seen =
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	256 #if SIZEOF_VOID_P == 8
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	257 (void *) 0xFFFFFFFFFFFFFFFF;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	258 #else
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	259 (void *) 0xFFFFFFFF;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	260 #endif
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	261 if ((char ) val < (char ) minimum_address_seen)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	262 minimum_address_seen = (char *) val;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	263 }
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	264
1315 70921960b980 [xemacs-hg @ 2003-02-20 08:19:28 by ben] ben parents: 1292 diff changeset	265 #ifdef ERROR_CHECK_MALLOC
3176 1c2a4e4e81d9 [xemacs-hg @ 2005-12-25 11:21:45 by aidan] aidan parents: 3170 diff changeset	266 static int in_malloc;
1333 1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben] ben parents: 1318 diff changeset	267 extern int regex_malloc_disallowed;
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	268
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	269 #define MALLOC_BEGIN() \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	270 do \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	271 { \
3176 1c2a4e4e81d9 [xemacs-hg @ 2005-12-25 11:21:45 by aidan] aidan parents: 3170 diff changeset	272 assert (!in_malloc); \
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	273 assert (!regex_malloc_disallowed); \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	274 in_malloc = 1; \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	275 } \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	276 while (0)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	277
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	278 #ifdef NEW_GC
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	279 #define FREE_OR_REALLOC_BEGIN(block) \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	280 do \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	281 { \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	282 /* 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	283 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	284 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	285 assert (block != (void *) DEADBEEF_CONSTANT); \
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	286 MALLOC_BEGIN (); \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	287 } \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	288 while (0)
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	289 #else /* not NEW_GC */
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	290 #define FREE_OR_REALLOC_BEGIN(block) \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	291 do \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	292 { \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	293 /* 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	294 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	295 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	296 assert (block != (void *) DEADBEEF_CONSTANT); \
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	297 /* 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	298 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	299 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	300 DUMPEDP. */ \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	301 assert (!DUMPEDP (block)); \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	302 MALLOC_BEGIN (); \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	303 } \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	304 while (0)
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	305 #endif /* not NEW_GC */
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	306
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	307 #define MALLOC_END() \
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	308 do \
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 in_malloc = 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 while (0)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	313
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	314 #else /* ERROR_CHECK_MALLOC */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	315
2658 a48989ca6db3 [xemacs-hg @ 2005-03-13 09:20:58 by crestani] crestani parents: 2650 diff changeset	316 #define MALLOC_BEGIN()
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	317 #define FREE_OR_REALLOC_BEGIN(block)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	318 #define MALLOC_END()
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 #endif /* ERROR_CHECK_MALLOC */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	321
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	322 static void
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	323 malloc_after (void *val, Bytecount size)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	324 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	325 if (!val && size != 0)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	326 memory_full ();
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	327 set_alloc_mins_and_maxes (val, size);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	328 }
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	329
3305 1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	330 /* 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	331 void
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	332 malloc_warning (const char *str)
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	333 {
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	334 if (ignore_malloc_warnings)
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	335 return;
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	336
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	337 /* 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	338 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	339 is already finished (malloc_warning is called via
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	340 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	341 malloc_warning). */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	342 MALLOC_END ();
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	343
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	344 warn_when_safe
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	345 (Qmemory, Qemergency,
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	346 "%s\n"
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	347 "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	348 "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	349 "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	350 str);
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	351 }
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	352
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	353 /* Called if malloc returns zero */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	354 DOESNT_RETURN
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	355 memory_full (void)
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	356 {
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	357 /* Force a GC next time eval is called.
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	358 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	359 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	360 */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	361 consing_since_gc = gc_cons_threshold + 1;
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	362 recompute_need_to_garbage_collect ();
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	363 #ifdef NEW_GC
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	364 /* 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	365 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	366 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	367 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	368 if (memory_shortage)
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	369 {
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	370 fprintf (stderr, "Memory full, cannot recover.\n");
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	371 ABORT ();
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	372 }
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	373 fprintf (stderr,
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	374 "Memory full, try to recover.\n"
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	375 "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	376 memory_shortage++;
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	377 #else /* not NEW_GC */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	378 release_breathing_space ();
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	379 #endif /* not NEW_GC */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	380
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	381 /* Flush some histories which might conceivably contain garbalogical
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	382 inhibitors. */
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	383 if (!NILP (Fboundp (Qvalues)))
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	384 Fset (Qvalues, Qnil);
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	385 Vcommand_history = Qnil;
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 out_of_memory ("Memory exhausted", Qunbound);
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	388 }
1043bbfa24cf [xemacs-hg @ 2006-03-26 15:24:25 by crestani] crestani parents: 3304 diff changeset	389
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	390 /* like malloc, calloc, realloc, free but:
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	391
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	392 -- check for no memory left
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	393 -- set internal mins and maxes
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	394 -- 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	395 */
1292 f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1276 diff changeset	396
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	397 #undef xmalloc
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	398 void *
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	399 xmalloc (Bytecount size)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	400 {
1292 f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1276 diff changeset	401 void *val;
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	402 MALLOC_BEGIN ();
1292 f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1276 diff changeset	403 val = malloc (size);
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	404 MALLOC_END ();
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	405 malloc_after (val, size);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	406 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	407 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	408
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	409 #undef xcalloc
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	410 static void *
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	411 xcalloc (Elemcount nelem, Bytecount elsize)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	412 {
1292 f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1276 diff changeset	413 void *val;
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	414 MALLOC_BEGIN ();
1292 f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1276 diff changeset	415 val= calloc (nelem, elsize);
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	416 MALLOC_END ();
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	417 malloc_after (val, nelem * elsize);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	418 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	419 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	420
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	421 void *
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	422 xmalloc_and_zero (Bytecount size)
428 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 return xcalloc (size, sizeof (char));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	425 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	426
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	427 #undef xrealloc
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	428 void *
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	429 xrealloc (void *block, Bytecount size)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	430 {
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	431 FREE_OR_REALLOC_BEGIN (block);
551 e9a3f8b4de53 [xemacs-hg @ 2001-05-21 05:26:06 by martinb] martinb parents: 460 diff changeset	432 block = realloc (block, size);
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	433 MALLOC_END ();
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	434 malloc_after (block, size);
551 e9a3f8b4de53 [xemacs-hg @ 2001-05-21 05:26:06 by martinb] martinb parents: 460 diff changeset	435 return block;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	436 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	437
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	438 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	439 xfree_1 (void *block)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	440 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	441 #ifdef ERROR_CHECK_MALLOC
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	442 assert (block);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	443 #endif /* ERROR_CHECK_MALLOC */
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	444 FREE_OR_REALLOC_BEGIN (block);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	445 free (block);
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	446 MALLOC_END ();
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	447 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	448
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	449 void
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	450 deadbeef_memory (void *ptr, Bytecount size)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	451 {
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 814 diff changeset	452 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	453 Bytecount beefs = size >> 2;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	454
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	455 /* In practice, size will always be a multiple of four. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	456 while (beefs--)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	457 (ptr4++) = 0xDEADBEEF; / -559038737 base 10 */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	458 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	459
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	460 #undef xstrdup
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	461 char *
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	462 xstrdup (const char *str)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	463 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	464 int len = strlen (str) + 1; /* for stupid terminating 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	465 void *val = xmalloc (len);
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	466
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	467 if (val == 0) return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	468 return (char *) memcpy (val, str, len);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	469 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	470
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	471 #ifdef NEED_STRDUP
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	472 char *
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	473 strdup (const char *s)
428 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 return xstrdup (s);
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 #endif /* NEED_STRDUP */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	478
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	479
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	480 /************************************************************************/
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	481 /* Lisp object allocation */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	482 /************************************************************************/
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	483
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	484 /* Determine now whether we need to garbage collect or not, to make
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	485 Ffuncall() faster */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	486 #define INCREMENT_CONS_COUNTER_1(size) \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	487 do \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	488 { \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	489 consing_since_gc += (size); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	490 total_consing += (size); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	491 if (profiling_active) \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	492 profile_record_consing (size); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	493 recompute_need_to_garbage_collect (); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	494 } while (0)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	495
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	496 #define debug_allocation_backtrace() \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	497 do { \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	498 if (debug_allocation_backtrace_length > 0) \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	499 debug_short_backtrace (debug_allocation_backtrace_length); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	500 } while (0)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	501
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	502 #ifdef DEBUG_XEMACS
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	503 #define INCREMENT_CONS_COUNTER(foosize, type) \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	504 do { \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	505 if (debug_allocation) \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	506 { \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	507 stderr_out ("allocating %s (size %ld)\n", type, \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	508 (long) foosize); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	509 debug_allocation_backtrace (); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	510 } \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	511 INCREMENT_CONS_COUNTER_1 (foosize); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	512 } while (0)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	513 #define NOSEEUM_INCREMENT_CONS_COUNTER(foosize, type) \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	514 do { \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	515 if (debug_allocation > 1) \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	516 { \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	517 stderr_out ("allocating noseeum %s (size %ld)\n", type, \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	518 (long) foosize); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	519 debug_allocation_backtrace (); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	520 } \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	521 INCREMENT_CONS_COUNTER_1 (foosize); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	522 } while (0)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	523 #else
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	524 #define INCREMENT_CONS_COUNTER(size, type) INCREMENT_CONS_COUNTER_1 (size)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	525 #define NOSEEUM_INCREMENT_CONS_COUNTER(size, type) \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	526 INCREMENT_CONS_COUNTER_1 (size)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	527 #endif
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	528
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	529 #ifdef NEW_GC
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	530 /* [[ The call to recompute_need_to_garbage_collect is moved to
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	531 free_normal_lisp_object, since DECREMENT_CONS_COUNTER is extensively called
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	532 during sweep and recomputing need_to_garbage_collect all the time
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	533 is not needed. ]] -- not accurate! */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	534 #define DECREMENT_CONS_COUNTER(size) do { \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	535 consing_since_gc -= (size); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	536 total_consing -= (size); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	537 if (profiling_active) \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	538 profile_record_unconsing (size); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	539 if (consing_since_gc < 0) \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	540 consing_since_gc = 0; \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	541 } while (0)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	542 #else /* not NEW_GC */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	543 #define DECREMENT_CONS_COUNTER(size) do { \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	544 consing_since_gc -= (size); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	545 total_consing -= (size); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	546 if (profiling_active) \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	547 profile_record_unconsing (size); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	548 if (consing_since_gc < 0) \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	549 consing_since_gc = 0; \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	550 recompute_need_to_garbage_collect (); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	551 } while (0)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	552 #endif /not NEW_GC /
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	553
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	554 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	555 static void *
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	556 allocate_lisp_storage (Bytecount size)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	557 {
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	558 void *val = xmalloc (size);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	559 /* 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	560 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	561 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	562 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	563 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	564 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	565 get freed?) */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	566
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	567 /* 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	568 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	569 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	570 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	571 redisplay structures are allocated separately. */
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	572 memset (val, 0, size);
851 e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben] ben parents: 826 diff changeset	573
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben] ben parents: 826 diff changeset	574 if (need_to_check_c_alloca)
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben] ben parents: 826 diff changeset	575 xemacs_c_alloca (0);
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben] ben parents: 826 diff changeset	576
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	577 return val;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	578 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	579 #endif /* not NEW_GC */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	580
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	581 #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	582 type_checking_assert \
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	583 (implementation->static_size == 0 ? \
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	584 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	585 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	586 implementation->static_size == size)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	587
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	588 #ifndef NEW_GC
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	589 /* lcrecords are chained together through their "next" field.
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	590 After doing the mark phase, GC will walk this linked list
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	591 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	592 static struct old_lcrecord_header *all_lcrecords;
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	593 #endif /* not NEW_GC */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	594
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	595 #ifdef NEW_GC
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	596 /* 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	597 static Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	598 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	599 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	600 int noseeum)
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	601 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	602 struct lrecord_header *lheader;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	603
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	604 assert_proper_sizing (size);
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	605
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	606 lheader = (struct lrecord_header *) mc_alloc (size);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	607 gc_checking_assert (LRECORD_FREE_P (lheader));
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	608 set_lheader_implementation (lheader, implementation);
2994 ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	609 #ifdef ALLOC_TYPE_STATS
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	610 inc_lrecord_stats (size, lheader);
2994 ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	611 #endif /* ALLOC_TYPE_STATS */
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	612 if (implementation->finalizer)
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	613 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	614 if (noseeum)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	615 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	616 else
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	617 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	618 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	619 }
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	620
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	621 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	622 alloc_sized_lrecord (Bytecount size,
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	623 const struct lrecord_implementation *implementation)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	624 {
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	625 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	626 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	627
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	628 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	629 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	630 const struct lrecord_implementation *
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	631 implementation)
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	632 {
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	633 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	634 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	635
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	636 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	637 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	638 {
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	639 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	640 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	641 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	642
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	643 Lisp_Object
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	644 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	645 {
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	646 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	647 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	648 }
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	649
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	650 Lisp_Object
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	651 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	652 const struct lrecord_implementation *implementation)
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	653 {
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	654 struct lrecord_header *lheader;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	655 Rawbyte start, stop;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	656
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	657 assert_proper_sizing (size);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	658
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	659 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	660 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	661
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	662 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	663 /* #### 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	664 stop = ((Rawbyte ) lheader) + (size elemcount -1);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	665 start < stop; start += size)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	666 {
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	667 struct lrecord_header lh = (struct lrecord_header ) start;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	668 set_lheader_implementation (lh, implementation);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	669 #ifdef ALLOC_TYPE_STATS
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	670 inc_lrecord_stats (size, lh);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	671 #endif /* not ALLOC_TYPE_STATS */
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	672 if (implementation->finalizer)
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	673 add_finalizable_obj (wrap_pointer_1 (lh));
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	674 }
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	675
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	676 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	677 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	678 }
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	679
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	680 Lisp_Object
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	681 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	682 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	683 {
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	684 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	685 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	686 implementation);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	687 }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	688
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	689 #else /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	690
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	691 /* 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	692 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	693 specified size. See lrecord.h. */
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	694
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	695 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	696 old_alloc_sized_lcrecord (Bytecount size,
3024 b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	697 const struct lrecord_implementation *implementation)
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	698 {
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	699 struct old_lcrecord_header *lcheader;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	700
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	701 assert_proper_sizing (size);
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	702 type_checking_assert
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	703 (!implementation->frob_block_p
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	704 &&
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	705 !(implementation->hash == NULL && implementation->equal != NULL));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	706
3024 b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	707 lcheader = (struct old_lcrecord_header *) allocate_lisp_storage (size);
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	708 set_lheader_implementation (&lcheader->lheader, implementation);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	709 lcheader->next = all_lcrecords;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	710 all_lcrecords = lcheader;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	711 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	712 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	713 }
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	714
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	715 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	716 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	717 {
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	718 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	719 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	720 implementation);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	721 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	722
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	723 #if 0 /* Presently unused */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	724 /* Very, very poor man's EGC?
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	725 * This may be slow and thrash pages all over the place.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	726 * Only call it if you really feel you must (and if the
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	727 * lrecord was fairly recently allocated).
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	728 * 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	729 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	730 void
3024 b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	731 very_old_free_lcrecord (struct old_lcrecord_header *lcrecord)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	732 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	733 if (all_lcrecords == lcrecord)
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 all_lcrecords = lcrecord->next;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	736 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	737 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	738 {
3024 b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	739 struct old_lcrecord_header *header = all_lcrecords;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	740 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	741 {
3024 b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	742 struct old_lcrecord_header *next = header->next;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	743 if (next == lcrecord)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	744 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	745 header->next = lrecord->next;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	746 break;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	747 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	748 else if (next == 0)
2500 3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben] ben parents: 2367 diff changeset	749 ABORT ();
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	750 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	751 header = next;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	752 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	753 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	754 if (lrecord->implementation->finalizer)
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	755 lrecord->implementation->finalizer (wrap_pointer_1 (lrecord));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	756 xfree (lrecord);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	757 return;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	758 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	759 #endif /* Unused */
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	760 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	761
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	762 /* 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	763
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	764 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	765 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	766 {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	767 const struct lrecord_implementation *imp =
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	768 XRECORD_LHEADER_IMPLEMENTATION (src);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	769 Bytecount size = lisp_object_size (src);
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 assert (imp == XRECORD_LHEADER_IMPLEMENTATION (dst));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	772 assert (size == lisp_object_size (dst));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	773
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	774 #ifdef NEW_GC
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	775 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	776 (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	777 size - sizeof (struct lrecord_header));
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	778 #else /* not NEW_GC */
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	779 if (imp->frob_block_p)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	780 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	781 (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header),
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	782 size - sizeof (struct lrecord_header));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	783 else
3024 b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	784 memcpy ((char *) XRECORD_LHEADER (dst) +
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	785 sizeof (struct old_lcrecord_header),
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	786 (char *) XRECORD_LHEADER (src) +
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	787 sizeof (struct old_lcrecord_header),
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	788 size - sizeof (struct old_lcrecord_header));
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	789 #endif /* not NEW_GC */
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	790 }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	791
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	792 /* 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	793 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	794 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	795 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	796 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	797
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	798 void
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	799 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	800 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	801 #ifndef NEW_GC
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	802 const struct lrecord_implementation *imp =
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	803 XRECORD_LHEADER_IMPLEMENTATION (obj);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	804 #endif /* not NEW_GC */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	805
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	806 #ifdef NEW_GC
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	807 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	808 size - sizeof (struct lrecord_header));
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	809 #else /* not NEW_GC */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	810 if (imp->frob_block_p)
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	811 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	812 size - sizeof (struct lrecord_header));
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	813 else
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	814 memset ((char *) XRECORD_LHEADER (obj) +
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	815 sizeof (struct old_lcrecord_header), 0,
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	816 size - sizeof (struct old_lcrecord_header));
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	817 #endif /* not NEW_GC */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	818 }
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	819
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	820 /* 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	821 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	822 zero_sized_lisp_object().
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	823 */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	824
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	825 void
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	826 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	827 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	828 const struct lrecord_implementation *imp =
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	829 XRECORD_LHEADER_IMPLEMENTATION (obj);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	830 assert (!imp->size_in_bytes_method);
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 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	833 }
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 void
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	836 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	837 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	838 #ifndef NEW_GC
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	839 const struct lrecord_implementation *imp =
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	840 XRECORD_LHEADER_IMPLEMENTATION (obj);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	841 #endif /* not NEW_GC */
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	842
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	843 #ifdef NEW_GC
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	844 /* 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	845 return;
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	846 #else
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	847 assert (!imp->frob_block_p);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	848 assert (!imp->size_in_bytes_method);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	849 old_free_lcrecord (obj);
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	850 #endif
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	851 }
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	852
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	853 #ifndef NEW_GC
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	854 int
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	855 c_readonly (Lisp_Object obj)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	856 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	857 return POINTER_TYPE_P (XTYPE (obj)) && C_READONLY (obj);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	858 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	859 #endif /* not NEW_GC */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	860
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	861 int
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	862 lisp_readonly (Lisp_Object obj)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	863 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	864 return POINTER_TYPE_P (XTYPE (obj)) && LISP_READONLY (obj);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	865 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	866
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	867 /* #### Should be made into an object method */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	868
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	869 int
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	870 object_dead_p (Lisp_Object obj)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	871 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	872 return ((BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj))) \|\|
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	873 (FRAMEP (obj) && !FRAME_LIVE_P (XFRAME (obj))) \|\|
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	874 (WINDOWP (obj) && !WINDOW_LIVE_P (XWINDOW (obj))) \|\|
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	875 (DEVICEP (obj) && !DEVICE_LIVE_P (XDEVICE (obj))) \|\|
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	876 (CONSOLEP (obj) && !CONSOLE_LIVE_P (XCONSOLE (obj))) \|\|
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	877 (EVENTP (obj) && !EVENT_LIVE_P (XEVENT (obj))) \|\|
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	878 (EXTENTP (obj) && !EXTENT_LIVE_P (XEXTENT (obj))));
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	879 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	880
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	881
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	882 /************************************************************************/
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	883 /* Debugger support */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	884 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	885 /* Give gdb/dbx enough information to decode Lisp Objects. We make
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	886 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	887 about expressions in src/.gdbinit. See src/.gdbinit or src/.dbxrc
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	888 to see how this is used. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	889
458 c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	890 EMACS_UINT dbg_valmask = ((1UL << VALBITS) - 1) << GCBITS;
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	891 EMACS_UINT dbg_typemask = (1UL << GCTYPEBITS) - 1;
428 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 #ifdef USE_UNION_TYPE
458 c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	894 unsigned char dbg_USE_UNION_TYPE = 1;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	895 #else
458 c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	896 unsigned char dbg_USE_UNION_TYPE = 0;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	897 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	898
458 c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	899 unsigned char dbg_valbits = VALBITS;
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	900 unsigned char dbg_gctypebits = GCTYPEBITS;
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	901
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	902 /* On some systems, the above definitions will be optimized away by
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	903 the compiler or linker unless they are referenced in some function. */
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	904 long dbg_inhibit_dbg_symbol_deletion (void);
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	905 long
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	906 dbg_inhibit_dbg_symbol_deletion (void)
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	907 {
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	908 return
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	909 (dbg_valmask +
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	910 dbg_typemask +
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	911 dbg_USE_UNION_TYPE +
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	912 dbg_valbits +
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	913 dbg_gctypebits);
c33ae14dd6d0 Import from CVS: tag r21-2-44 cvs parents: 456 diff changeset	914 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	915
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	916 /* Macros turned into functions for ease of debugging.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	917 Debuggers don't know about macros! */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	918 int dbg_eq (Lisp_Object obj1, Lisp_Object obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	919 int
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	920 dbg_eq (Lisp_Object obj1, Lisp_Object obj2)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	921 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	922 return EQ (obj1, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	923 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	924
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	925
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	926 #ifdef NEW_GC
3017 1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben] ben parents: 2994 diff changeset	927 #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	928 #else
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	929 /************************************************************************/
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	930 /* Fixed-size type macros */
428 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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	933 /* For fixed-size types that are commonly used, we malloc() large blocks
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	934 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	935 size for an object of that type. This is more efficient than
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	936 malloc()ing each object separately because we save on malloc() time
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	937 and overhead due to the fewer number of malloc()ed blocks, and
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	938 also because we don't need any extra pointers within each object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	939 to keep them threaded together for GC purposes. For less common
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	940 (and frequently large-size) types, we use lcrecords, which are
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	941 malloc()ed individually and chained together through a pointer
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	942 in the lcrecord header. lcrecords do not need to be fixed-size
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	943 (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	944 however, the size of a particular object cannot vary dynamically).
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	945 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	946 additional code needs to be added to alloc.c. Finally, lcrecords
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	947 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	948
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	949 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	950 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	951 marker, extent, event, and string.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	952
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	953 Note that strings are special in that they are actually stored in
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	954 two parts: a structure containing information about the string, and
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	955 the actual data associated with the string. The former structure
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	956 (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	957 same way as all the other such types. This structure contains a
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	958 pointer to the actual string data, which is stored in structures of
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	959 type struct string_chars_block. Each string_chars_block consists
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	960 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	961 string, followed by another pointer to a Lisp_String, followed by
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	962 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	963 blocks is compacted by searching sequentially through all the
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	964 blocks and compressing out any holes created by unmarked strings.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	965 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	966 a string_chars_block, although something like half as big might
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	967 make more sense) are malloc()ed separately and not stored in
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	968 string_chars_blocks. Furthermore, no one string stretches across
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	969 two string_chars_blocks.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	970
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	971 Vectors are each malloc()ed separately as lcrecords.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	972
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	973 In the following discussion, we use conses, but it applies equally
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	974 well to the other fixed-size types.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	975
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	976 We store cons cells inside of cons_blocks, allocating a new
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	977 cons_block with malloc() whenever necessary. Cons cells reclaimed
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	978 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	979 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	980 just under 2^n - MALLOC_OVERHEAD bytes long, since malloc (at least
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	981 the versions in malloc.c and gmalloc.c) really allocates in units
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	982 of powers of two and uses 4 bytes for its own overhead.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	983
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	984 What GC actually does is to search through all the cons_blocks,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	985 from the most recently allocated to the oldest, and put all
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	986 cons cells that are not marked (whether or not they're already
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	987 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	988 so the cons cells in the oldest-allocated cons_block end up
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	989 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	990 If any cons_block is entirely free, it is freed with free()
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	991 and its cons cells removed from the cons_free_list. Because
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	992 the cons_free_list ends up basically in memory order, we have
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	993 a high locality of reference (assuming a reasonable turnover
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	994 of allocating and freeing) and have a reasonable probability
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	995 of entirely freeing up cons_blocks that have been more recently
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	996 allocated. This stage is called the "sweep stage" of GC, and
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	997 is executed after the "mark stage", which involves starting
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	998 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	999 (e.g. the obarray, where are all symbols are stored; the
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1000 current catches and condition-cases; the backtrace list of
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1001 currently executing functions; the gcpro list; etc.) and
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1002 recursively marking all objects that are accessible.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1003
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1004 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	1005 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	1006 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	1007 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	1008 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	1009 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	1010 macro. This uses a special lrecord type `lrecord_type_free',
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1011 which is never associated with any valid object.
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1012
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1013 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	1014 in the conses themselves. Because the cons is still in a
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1015 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	1016 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	1017 indicator and the chaining pointer. So this pointer is stored
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1018 after the lrecord header (actually where C places a pointer after
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1019 the lrecord header; they are not necessarily contiguous). This
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1020 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	1021 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	1022 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	1023 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	1024 ensure adequate space for the free list chain pointer.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1025
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1026 Some types of objects need additional "finalization" done
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1027 when an object is converted from in use to not in use;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1028 this is the purpose of the ADDITIONAL_FREE_type macro.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1029 For example, markers need to be removed from the chain
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1030 of markers that is kept in each buffer. This is because
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1031 markers in a buffer automatically disappear if the marker
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1032 is no longer referenced anywhere (the same does not
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1033 apply to extents, however).
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1034
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1035 WARNING: Things are in an extremely bizarre state when
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1036 the ADDITIONAL_FREE_type macros are called, so beware!
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1037
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1038 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	1039 maximize our chances of catching places where there is insufficient
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1040 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	1041 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	1042 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	1043 something seemingly unrelated getting trashed, and is extremely
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1044 difficult to track down. If the object gets freed but not
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1045 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	1046 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	1047 to the invalid type `lrecord_type_free', however, and a pointer
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1048 used to chain freed objects together is stored after the lrecord
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1049 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	1050 bogus, so crashes are more likely to occur right away.)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1051
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1052 We want freed objects to stay free as long as possible,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1053 so instead of doing what we do above, we maintain the
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1054 free objects in a first-in first-out queue. We also
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1055 don't recompute the free list each GC, unlike above;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1056 this ensures that the queue ordering is preserved.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1057 [This means that we are likely to have worse locality
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1058 of reference, and that we can never free a frob block
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1059 once it's allocated. (Even if we know that all cells
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1060 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	1061 cells from the free list because the objects on the
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1062 free list are unlikely to be in memory order.)]
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1063 Furthermore, we never take objects off the free list
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1064 unless there's a large number (usually 1000, but
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1065 varies depending on type) of them already on the list.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1066 This way, we ensure that an object that gets freed will
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1067 remain free for the next 1000 (or whatever) times that
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1068 an object of that type is allocated. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1069
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1070 #ifdef ALLOC_NO_POOLS
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1071 # define TYPE_ALLOC_SIZE(type, structtype) 1
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1072 #else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1073 # define TYPE_ALLOC_SIZE(type, structtype) \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1074 ((2048 - MALLOC_OVERHEAD - sizeof (struct type##_block *)) \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1075 / sizeof (structtype))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1076 #endif /* ALLOC_NO_POOLS */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1077
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1078 #define DECLARE_FIXED_TYPE_ALLOC(type, structtype) \
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 struct type##_block \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1081 { \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1082 struct type##_block *prev; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1083 structtype block[TYPE_ALLOC_SIZE (type, structtype)]; \
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 \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1086 static struct type##_block *current_##type##_block; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1087 static int current_##type##_block_index; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1088 \
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1089 static Lisp_Free *type##_free_list; \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1090 static Lisp_Free *type##_free_list_tail; \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1091 \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1092 static void \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1093 init_##type##_alloc (void) \
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 current_##type##_block = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1096 current_##type##_block_index = \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1097 countof (current_##type##_block->block); \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1098 type##_free_list = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1099 type##_free_list_tail = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1100 } \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1101 \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1102 static int gc_count_num_##type##_in_use; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1103 static int gc_count_num_##type##_freelist
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 #define ALLOCATE_FIXED_TYPE_FROM_BLOCK(type, result) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1106 if (current_##type##_block_index \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1107 == countof (current_##type##_block->block)) \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1108 { \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1109 struct type##_block AFTFB_new = (struct type##_block ) \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1110 allocate_lisp_storage (sizeof (struct type##_block)); \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1111 AFTFB_new->prev = current_##type##_block; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1112 current_##type##_block = AFTFB_new; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1113 current_##type##_block_index = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1114 } \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1115 (result) = \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1116 &(current_##type##_block->block[current_##type##_block_index++]); \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1117 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1118
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1119 /* Allocate an instance of a type that is stored in blocks.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1120 TYPE is the "name" of the type, STRUCTTYPE is the corresponding
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1121 structure type. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1122
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1123 #ifdef ERROR_CHECK_GC
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1124
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1125 /* Note: if you get crashes in this function, suspect incorrect calls
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1126 to free_cons() and friends. This happened once because the cons
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1127 cell was not GC-protected and was getting collected before
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1128 free_cons() was called. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1129
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1130 #define ALLOCATE_FIXED_TYPE_1(type, structtype, result) do { \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1131 if (gc_count_num_##type##_freelist > \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1132 MINIMUM_ALLOWED_FIXED_TYPE_CELLS_##type) \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1133 { \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1134 result = (structtype *) type##_free_list; \
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	1135 assert (LRECORD_FREE_P (result)); \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	1136 /* Before actually using the chain pointer, we complement \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	1137 all its bits; see PUT_FIXED_TYPE_ON_FREE_LIST(). */ \
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1138 type##_free_list = (Lisp_Free *) \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1139 (~ (EMACS_UINT) (type##_free_list->chain)); \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1140 gc_count_num_##type##_freelist--; \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1141 } \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1142 else \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1143 ALLOCATE_FIXED_TYPE_FROM_BLOCK (type, result); \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1144 MARK_LRECORD_AS_NOT_FREE (result); \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1145 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1146
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1147 #else /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1148
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1149 #define ALLOCATE_FIXED_TYPE_1(type, structtype, result) do { \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1150 if (type##_free_list) \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1151 { \
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1152 result = (structtype *) type##_free_list; \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1153 type##_free_list = type##_free_list->chain; \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1154 } \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1155 else \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1156 ALLOCATE_FIXED_TYPE_FROM_BLOCK (type, result); \
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1157 MARK_LRECORD_AS_NOT_FREE (result); \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1158 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1159
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1160 #endif /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1161
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1162
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1163 #define ALLOCATE_FIXED_TYPE(type, structtype, result) \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1164 do \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1165 { \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1166 ALLOCATE_FIXED_TYPE_1 (type, structtype, result); \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1167 INCREMENT_CONS_COUNTER (sizeof (structtype), #type); \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1168 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1169
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1170 #define NOSEEUM_ALLOCATE_FIXED_TYPE(type, structtype, result) \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1171 do \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1172 { \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1173 ALLOCATE_FIXED_TYPE_1 (type, structtype, result); \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1174 NOSEEUM_INCREMENT_CONS_COUNTER (sizeof (structtype), #type); \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1175 } while (0)
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 /* 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	1178 block of any lisp object type. */
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1179 typedef struct Lisp_Free
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1180 {
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1181 struct lrecord_header lheader;
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1182 struct Lisp_Free *chain;
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1183 } Lisp_Free;
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1184
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1185 #define LRECORD_FREE_P(ptr) \
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	1186 (((struct lrecord_header *) ptr)->type == lrecord_type_free)
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1187
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1188 #define MARK_LRECORD_AS_FREE(ptr) \
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	1189 ((void) (((struct lrecord_header *) ptr)->type = lrecord_type_free))
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1190
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1191 #ifdef ERROR_CHECK_GC
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1192 #define MARK_LRECORD_AS_NOT_FREE(ptr) \
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	1193 ((void) (((struct lrecord_header *) ptr)->type = lrecord_type_undefined))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1194 #else
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1195 #define MARK_LRECORD_AS_NOT_FREE(ptr) DO_NOTHING
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1196 #endif
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 #ifdef ERROR_CHECK_GC
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1199
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1200 #define PUT_FIXED_TYPE_ON_FREE_LIST(type, structtype, ptr) do { \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1201 if (type##_free_list_tail) \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1202 { \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1203 /* When we store the chain pointer, we complement all \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1204 its bits; this should significantly increase its \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1205 bogosity in case someone tries to use the value, and \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1206 should make us crash faster if someone overwrites the \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1207 pointer because when it gets un-complemented in \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1208 ALLOCATED_FIXED_TYPE(), the resulting pointer will be \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1209 extremely bogus. */ \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1210 type##_free_list_tail->chain = \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1211 (Lisp_Free *) ~ (EMACS_UINT) (ptr); \
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 else \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1214 type##_free_list = (Lisp_Free *) (ptr); \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1215 type##_free_list_tail = (Lisp_Free *) (ptr); \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1216 } while (0)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1217
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1218 #else /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1219
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1220 #define PUT_FIXED_TYPE_ON_FREE_LIST(type, structtype, ptr) do { \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1221 ((Lisp_Free *) (ptr))->chain = type##_free_list; \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1222 type##_free_list = (Lisp_Free *) (ptr); \
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1223 } while (0) \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1224
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1225 #endif /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1226
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1227 /* TYPE and STRUCTTYPE are the same as in ALLOCATE_FIXED_TYPE(). */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1228
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1229 #define FREE_FIXED_TYPE(type, structtype, ptr) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1230 structtype *FFT_ptr = (ptr); \
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	1231 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	1232 gc_checking_assert (!DUMPEDP (FFT_ptr)); \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1233 ADDITIONAL_FREE_##type (FFT_ptr); \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1234 deadbeef_memory (FFT_ptr, sizeof (structtype)); \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1235 PUT_FIXED_TYPE_ON_FREE_LIST (type, structtype, FFT_ptr); \
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	1236 MARK_LRECORD_AS_FREE (FFT_ptr); \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1237 } while (0)
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	1238 #endif /* NEW_GC */
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	1239
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	1240 #ifdef NEW_GC
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	1241 #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	1242 free_normal_lisp_object (lo)
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	1243 #else /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1244 /* Like FREE_FIXED_TYPE() but used when we are explicitly
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1245 freeing a structure through free_cons(), free_marker(), etc.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1246 rather than through the normal process of sweeping.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1247 We attempt to undo the changes made to the allocation counters
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1248 as a result of this structure being allocated. This is not
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1249 completely necessary but helps keep things saner: e.g. this way,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1250 repeatedly allocating and freeing a cons will not result in
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1251 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	1252 and somewhat defeat the purpose of explicitly freeing.
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	1253
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	1254 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	1255 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	1256
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	1257 #ifndef ALLOC_NO_POOLS
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	1258 #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	1259 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	1260 DECREMENT_CONS_COUNTER (sizeof (structtype)); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	1261 gc_count_num_##type##_freelist++; \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1262 } while (0)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	1263 #else
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	1264 #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	1265 #endif
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	1266 #endif /* (not) NEW_GC */
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	1267
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	1268 #ifdef NEW_GC
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1269 #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	1270 do { \
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1271 (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	1272 } while (0)
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1273 #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	1274 lrec_ptr) \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben] ben parents: 2994 diff changeset	1275 do { \
5120 d1247f3cc363 latest work on lisp-object workspace; Ben Wing <ben@xemacs.org> parents: 5118 diff changeset	1276 (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	1277 } while (0)
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	1278 #else /* not NEW_GC */
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1279 #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	1280 do \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben] ben parents: 2994 diff changeset	1281 { \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben] ben parents: 2994 diff changeset	1282 ALLOCATE_FIXED_TYPE (type, lisp_type, var); \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben] ben parents: 2994 diff changeset	1283 set_lheader_implementation (&(var)->lheader, lrec_ptr); \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben] ben parents: 2994 diff changeset	1284 } while (0)
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1285 #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	1286 lrec_ptr) \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben] ben parents: 2994 diff changeset	1287 do \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben] ben parents: 2994 diff changeset	1288 { \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben] ben parents: 2994 diff changeset	1289 NOSEEUM_ALLOCATE_FIXED_TYPE (type, lisp_type, var); \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben] ben parents: 2994 diff changeset	1290 set_lheader_implementation (&(var)->lheader, lrec_ptr); \
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben] ben parents: 2994 diff changeset	1291 } while (0)
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	1292 #endif /* not NEW_GC */
3017 1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben] ben parents: 2994 diff changeset	1293
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1294
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1295
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1296 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1297 /* Cons allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1298 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1299
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1300 DECLARE_FIXED_TYPE_ALLOC (cons, Lisp_Cons);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1301 /* 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	1302 /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 20000 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1303 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 2000
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1304
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1305 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1306 mark_cons (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1307 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1308 if (NILP (XCDR (obj)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1309 return XCAR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1310
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1311 mark_object (XCAR (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1312 return XCDR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1313 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1314
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1315 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	1316 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	1317 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1318 depth++;
4906 6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	1319 while (internal_equal_0 (XCAR (ob1), XCAR (ob2), depth, foldcase))
428 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 ob1 = XCDR (ob1);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1322 ob2 = XCDR (ob2);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1323 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	1324 return internal_equal_0 (ob1, ob2, depth, foldcase);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1325 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1326 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1327 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1328
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	1329 static const struct memory_description cons_description[] = {
853 2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben] ben parents: 851 diff changeset	1330 { XD_LISP_OBJECT, offsetof (Lisp_Cons, car_) },
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben] ben parents: 851 diff changeset	1331 { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr_) },
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1332 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1333 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1334
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	1335 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	1336 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	1337 /*
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	1338 * 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	1339 * 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	1340 * handle conses.
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	1341 */
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	1342 0, cons_description, Lisp_Cons);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1343
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1344 DEFUN ("cons", Fcons, 2, 2, 0, /*
3355 721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan] aidan parents: 3305 diff changeset	1345 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	1346
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan] aidan parents: 3305 diff changeset	1347 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	1348 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	1349 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	1350 series of cons cells.
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan] aidan parents: 3305 diff changeset	1351
721daee0fcd8 [xemacs-hg @ 2006-04-23 20:12:25 by aidan] aidan parents: 3305 diff changeset	1352 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	1353 `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	1354 `rplaca' and `rplacd' (for `setcar' and `setcdr') are supported.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1355 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1356 (car, cdr))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1357 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1358 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1359 Lisp_Object val;
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1360 Lisp_Cons *c;
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1361
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1362 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	1363 val = wrap_cons (c);
853 2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben] ben parents: 851 diff changeset	1364 XSETCAR (val, car);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben] ben parents: 851 diff changeset	1365 XSETCDR (val, cdr);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1366 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1367 }
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 /* 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	1370 going to free later, and is useful when trying to track down
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1371 "real" consing. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1372 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1373 noseeum_cons (Lisp_Object car, Lisp_Object cdr)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1374 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1375 Lisp_Object val;
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1376 Lisp_Cons *c;
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1377
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1378 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	1379 val = wrap_cons (c);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1380 XCAR (val) = car;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1381 XCDR (val) = cdr;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1382 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1383 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1384
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1385 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	1386 Return a newly created list with specified ARGS as elements.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1387 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	1388
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs. Aidan Kehoe <kehoea@parhasard.net> parents: 3514 diff changeset	1389 arguments: (&rest ARGS)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1390 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1391 (int nargs, Lisp_Object *args))
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 Lisp_Object val = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1394 Lisp_Object *argp = args + nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1395
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1396 while (argp > args)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1397 val = Fcons (*--argp, val);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1398 return val;
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1401 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1402 list1 (Lisp_Object obj0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1403 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1404 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1405 return Fcons (obj0, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1406 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1407
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1408 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1409 list2 (Lisp_Object obj0, Lisp_Object obj1)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1410 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1411 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1412 return Fcons (obj0, Fcons (obj1, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1413 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1414
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1415 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1416 list3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2)
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 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1419 return Fcons (obj0, Fcons (obj1, Fcons (obj2, Qnil)));
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1422 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1423 cons3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2)
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 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1426 return Fcons (obj0, Fcons (obj1, obj2));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1427 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1428
5354 22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	1429 DEFUN ("acons", Facons, 3, 3, 0, /*
22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	1430 Return a new alist created by prepending (KEY . VALUE) to ALIST.
22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	1431 */
22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	1432 (key, value, alist))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1433 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1434 return Fcons (Fcons (key, value), alist);
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1437 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1438 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	1439 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1440 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1441 return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Qnil))));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1442 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1443
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1444 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1445 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	1446 Lisp_Object obj4)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1447 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1448 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1449 return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Fcons (obj4, Qnil)))));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1450 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1451
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1452 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1453 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	1454 Lisp_Object obj4, Lisp_Object obj5)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1455 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1456 /* This cannot GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1457 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	1458 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1459
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1460 /* Return a list of arbitrary length, terminated by Qunbound. */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1461
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1462 Lisp_Object
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1463 listu (Lisp_Object first, ...)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1464 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1465 Lisp_Object obj = Qnil;
5386 af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1466
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1467 if (!UNBOUNDP (first))
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1468 {
5386 af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1469 va_list va;
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1470 Lisp_Object last, val;
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1471
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1472 last = obj = Fcons (first, Qnil);
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1473 va_start (va, first);
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1474 val = va_arg (va, Lisp_Object);
5386 af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1475 while (!UNBOUNDP (val))
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1476 {
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1477 last = XCDR (last) = Fcons (val, Qnil);
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1478 val = va_arg (va, Lisp_Object);
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1479 }
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1480 va_end (va);
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1481 }
5386 af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1482 return obj;
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1483 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1484
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1485 /* Return a list of arbitrary length, with length specified and remaining
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1486 args making up the list. */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1487
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1488 Lisp_Object
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1489 listn (int num_args, ...)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1490 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1491 Lisp_Object obj = Qnil;
5386 af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1492
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1493 if (num_args > 0)
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1494 {
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1495 va_list va;
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1496 Lisp_Object last;
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1497 int i;
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1498
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1499 va_start (va, num_args);
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1500 last = obj = Fcons (va_arg (va, Lisp_Object), Qnil);
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1501 for (i = 1; i < num_args; i++)
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1502 last = XCDR (last) = Fcons (va_arg (va, Lisp_Object), Qnil);
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1503 va_end (va);
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1504 }
af961911bcb2 Make listu() and listn() assemble lists in forward order. Use them. Jerry James <james@xemacs.org> parents: 5384 diff changeset	1505 return obj;
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1506 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1507
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1508 /* Return a list of arbitrary length, with length specified and an array
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1509 of elements. */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	1510
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1511 DEFUN ("make-list", Fmake_list, 2, 2, 0, /*
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	1512 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	1513 */
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	1514 (length, object))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1515 {
5307 c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	1516 Lisp_Object val = Qnil;
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	1517 Elemcount size;
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	1518
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	1519 check_integer_range (length, Qzero, make_integer (EMACS_INT_MAX));
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	1520
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	1521 size = XINT (length);
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	1522
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	1523 while (size--)
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	1524 val = Fcons (object, val);
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	1525
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	1526 return val;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1527 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1528
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1529
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1530 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1531 /* Float allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1532 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1533
1983 9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1534 /*** With enhanced number support, these are short floats */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1535
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1536 DECLARE_FIXED_TYPE_ALLOC (float, Lisp_Float);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1537 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_float 1000
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1538
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1539 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1540 make_float (double float_value)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1541 {
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1542 Lisp_Float *f;
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1543
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1544 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	1545
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1546 /* Avoid dump-time `uninitialized memory read' purify warnings. */
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1547 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	1548 zero_nonsized_lisp_object (wrap_float (f));
3017 1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben] ben parents: 2994 diff changeset	1549
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1550 float_data (f) = float_value;
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	1551 return wrap_float (f);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1552 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1553
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1554
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1555 /************************************************************************/
1983 9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1556 /* Enhanced number allocation */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1557 /************************************************************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1558
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1559 /* Bignum */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1560 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1561 DECLARE_FIXED_TYPE_ALLOC (bignum, Lisp_Bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1562 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_bignum 250
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1563
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1564 /* 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	1565 fixnum. See Fcanonicalize_number(). */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1566 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1567 make_bignum (long bignum_value)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1568 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1569 Lisp_Bignum *b;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1570
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1571 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	1572 bignum_init (bignum_data (b));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1573 bignum_set_long (bignum_data (b), bignum_value);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1574 return wrap_bignum (b);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1575 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1576
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1577 /* 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	1578 fixnum. See Fcanonicalize_number(). */
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_bignum_bg (bignum bg)
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_Bignum *b;
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 (bignum, Lisp_Bignum, b, &lrecord_bignum);
1983 9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1585 bignum_init (bignum_data (b));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1586 bignum_set (bignum_data (b), bg);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1587 return wrap_bignum (b);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1588 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1589 #endif /* HAVE_BIGNUM */
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 /* Ratio */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1592 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1593 DECLARE_FIXED_TYPE_ALLOC (ratio, Lisp_Ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1594 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_ratio 250
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1595
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1596 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1597 make_ratio (long numerator, unsigned long denominator)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1598 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1599 Lisp_Ratio *r;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1600
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1601 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	1602 ratio_init (ratio_data (r));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1603 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	1604 ratio_canonicalize (ratio_data (r));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1605 return wrap_ratio (r);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1606 }
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 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1609 make_ratio_bg (bignum numerator, bignum denominator)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1610 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1611 Lisp_Ratio *r;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1612
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1613 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	1614 ratio_init (ratio_data (r));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1615 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	1616 ratio_canonicalize (ratio_data (r));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1617 return wrap_ratio (r);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1618 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1619
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1620 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1621 make_ratio_rt (ratio rat)
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 Lisp_Ratio *r;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1624
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1625 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	1626 ratio_init (ratio_data (r));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1627 ratio_set (ratio_data (r), rat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1628 return wrap_ratio (r);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1629 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1630 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1631
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1632 /* Bigfloat */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1633 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1634 DECLARE_FIXED_TYPE_ALLOC (bigfloat, Lisp_Bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1635 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_bigfloat 250
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 /* 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	1638 PRECISION argument is zero. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1639 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1640 make_bigfloat (double float_value, unsigned long precision)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1641 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1642 Lisp_Bigfloat *f;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1643
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1644 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	1645 if (precision == 0UL)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1646 bigfloat_init (bigfloat_data (f));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1647 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1648 bigfloat_init_prec (bigfloat_data (f), precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1649 bigfloat_set_double (bigfloat_data (f), float_value);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1650 return wrap_bigfloat (f);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1651 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1652
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1653 /* 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	1654 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1655 make_bigfloat_bf (bigfloat float_value)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1656 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1657 Lisp_Bigfloat *f;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1658
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1659 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	1660 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	1661 bigfloat_set (bigfloat_data (f), float_value);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1662 return wrap_bigfloat (f);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1663 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1664 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1665
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	1666 /************************************************************************/
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1667 /* Vector allocation */
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1670 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1671 mark_vector (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1672 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1673 Lisp_Vector *ptr = XVECTOR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1674 int len = vector_length (ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1675 int i;
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 for (i = 0; i < len - 1; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1678 mark_object (ptr->contents[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1679 return (len > 0) ? ptr->contents[len - 1] : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1680 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1681
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1682 static Bytecount
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1683 size_vector (Lisp_Object obj)
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1684 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1685
456 e7ef97881643 Import from CVS: tag r21-2-43 cvs parents: 454 diff changeset	1686 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	1687 XVECTOR (obj)->size);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1688 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1689
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1690 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	1691 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	1692 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1693 int len = XVECTOR_LENGTH (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1694 if (len != XVECTOR_LENGTH (obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1695 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1696
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1697 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1698 Lisp_Object *ptr1 = XVECTOR_DATA (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1699 Lisp_Object *ptr2 = XVECTOR_DATA (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1700 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	1701 if (!internal_equal_0 (ptr1++, ptr2++, depth + 1, foldcase))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1702 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1703 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1704 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1705 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1706
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1707 static Hashcode
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5179 diff changeset	1708 vector_hash (Lisp_Object obj, int depth, Boolint equalp)
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1709 {
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1710 return HASH2 (XVECTOR_LENGTH (obj),
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1711 internal_array_hash (XVECTOR_DATA (obj),
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1712 XVECTOR_LENGTH (obj),
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5179 diff changeset	1713 depth + 1, equalp));
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1714 }
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1715
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	1716 static const struct memory_description vector_description[] = {
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1717 { XD_LONG, offsetof (Lisp_Vector, size) },
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1718 { 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	1719 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1720 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1721
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	1722 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	1723 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	1724 vector_equal,
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	1725 vector_hash,
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	1726 vector_description,
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	1727 size_vector, Lisp_Vector);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1728 /* #### should allocate `small' vectors from a frob-block */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1729 static Lisp_Vector *
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1730 make_vector_internal (Elemcount sizei)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1731 {
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	1732 /* no `next' field; we use lcrecords */
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1733 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	1734 contents, sizei);
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	1735 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	1736 Lisp_Vector *p = XVECTOR (obj);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1737
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1738 p->size = sizei;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1739 return p;
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1742 Lisp_Object
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1743 make_vector (Elemcount length, Lisp_Object object)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1744 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1745 Lisp_Vector *vecp = make_vector_internal (length);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1746 Lisp_Object *p = vector_data (vecp);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1747
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1748 while (length--)
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	1749 *p++ = object;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1750
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	1751 return wrap_vector (vecp);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1752 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1753
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1754 DEFUN ("make-vector", Fmake_vector, 2, 2, 0, /*
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	1755 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	1756 See also the function `vector'.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1757 */
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	1758 (length, object))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1759 {
5307 c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	1760 check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT));
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	1761 return make_vector (XINT (length), object);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1762 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1763
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1764 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	1765 Return a newly created vector with specified ARGS as elements.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1766 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	1767
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs. Aidan Kehoe <kehoea@parhasard.net> parents: 3514 diff changeset	1768 arguments: (&rest ARGS)
428 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 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1771 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1772 Lisp_Vector *vecp = make_vector_internal (nargs);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1773 Lisp_Object *p = vector_data (vecp);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1774
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1775 while (nargs--)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1776 p++ = args++;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1777
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	1778 return wrap_vector (vecp);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1779 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1780
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1781 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1782 vector1 (Lisp_Object obj0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1783 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1784 return Fvector (1, &obj0);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1785 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1786
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1787 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1788 vector2 (Lisp_Object obj0, Lisp_Object obj1)
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 Lisp_Object args[2];
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1791 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1792 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1793 return Fvector (2, args);
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1796 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1797 vector3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1798 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1799 Lisp_Object args[3];
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1800 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1801 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1802 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1803 return Fvector (3, args);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1804 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1805
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1806 #if 0 /* currently unused */
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1809 vector4 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1810 Lisp_Object obj3)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1811 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1812 Lisp_Object args[4];
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1813 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1814 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1815 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1816 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1817 return Fvector (4, args);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1818 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1819
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1820 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1821 vector5 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1822 Lisp_Object obj3, Lisp_Object obj4)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1823 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1824 Lisp_Object args[5];
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1825 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1826 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1827 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1828 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1829 args[4] = obj4;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1830 return Fvector (5, args);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1831 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1832
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1833 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1834 vector6 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1835 Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1836 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1837 Lisp_Object args[6];
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1838 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1839 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1840 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1841 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1842 args[4] = obj4;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1843 args[5] = obj5;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1844 return Fvector (6, args);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1845 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1846
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1847 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1848 vector7 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1849 Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1850 Lisp_Object obj6)
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 Lisp_Object args[7];
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1853 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1854 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1855 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1856 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1857 args[4] = obj4;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1858 args[5] = obj5;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1859 args[6] = obj6;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1860 return Fvector (7, args);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1861 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1862
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1863 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1864 vector8 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1865 Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1866 Lisp_Object obj6, Lisp_Object obj7)
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 Lisp_Object args[8];
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1869 args[0] = obj0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1870 args[1] = obj1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1871 args[2] = obj2;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1872 args[3] = obj3;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1873 args[4] = obj4;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1874 args[5] = obj5;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1875 args[6] = obj6;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1876 args[7] = obj7;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1877 return Fvector (8, args);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1878 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1879 #endif /* unused */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1880
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1881 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1882 /* Bit Vector allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1883 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1884
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1885 /* #### should allocate `small' bit vectors from a frob-block */
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1886 static Lisp_Bit_Vector *
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1887 make_bit_vector_internal (Elemcount sizei)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1888 {
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	1889 /* no `next' field; we use lcrecords */
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1890 Elemcount num_longs = BIT_VECTOR_LONG_STORAGE (sizei);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1891 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	1892 unsigned long,
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	1893 bits, num_longs);
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	1894 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	1895 Lisp_Bit_Vector *p = XBIT_VECTOR (obj);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1896
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1897 bit_vector_length (p) = sizei;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1898 return p;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1899 }
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 Lisp_Object
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1902 make_bit_vector (Elemcount length, Lisp_Object bit)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1903 {
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1904 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	1905 Elemcount num_longs = BIT_VECTOR_LONG_STORAGE (length);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1906
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	1907 CHECK_BIT (bit);
576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	1908
576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	1909 if (ZEROP (bit))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1910 memset (p->bits, 0, num_longs * sizeof (long));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1911 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1912 {
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1913 Elemcount bits_in_last = length & (LONGBITS_POWER_OF_2 - 1);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1914 memset (p->bits, ~0, num_longs * sizeof (long));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1915 /* But we have to make sure that the unused bits in the
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1916 last long are 0, so that equal/hash is easy. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1917 if (bits_in_last)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1918 p->bits[num_longs - 1] &= (1 << bits_in_last) - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1919 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1920
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	1921 return wrap_bit_vector (p);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1922 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1923
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1924 Lisp_Object
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1925 make_bit_vector_from_byte_vector (unsigned char *bytevec, Elemcount length)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1926 {
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1927 Elemcount i;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1928 Lisp_Bit_Vector *p = make_bit_vector_internal (length);
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 < length; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1931 set_bit_vector_bit (p, i, bytevec[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1932
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	1933 return wrap_bit_vector (p);
428 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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1936 DEFUN ("make-bit-vector", Fmake_bit_vector, 2, 2, 0, /*
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	1937 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	1938 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	1939 */
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	1940 (length, bit))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1941 {
5307 c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	1942 check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT));
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	1943 return make_bit_vector (XINT (length), bit);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1944 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1945
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1946 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	1947 Return a newly created bit vector with specified ARGS as elements.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1948 Any number of arguments, even zero arguments, are allowed.
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	1949 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	1950
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs. Aidan Kehoe <kehoea@parhasard.net> parents: 3514 diff changeset	1951 arguments: (&rest ARGS)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1952 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1953 (int nargs, Lisp_Object *args))
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 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1956 Lisp_Bit_Vector *p = make_bit_vector_internal (nargs);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1957
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1958 for (i = 0; i < nargs; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1959 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1960 CHECK_BIT (args[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1961 set_bit_vector_bit (p, i, !ZEROP (args[i]));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1962 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1963
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	1964 return wrap_bit_vector (p);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1965 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1966
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1967
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1968 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1969 /* Compiled-function allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1970 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1971
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1972 DECLARE_FIXED_TYPE_ALLOC (compiled_function, Lisp_Compiled_Function);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1973 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_compiled_function 1000
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1976 make_compiled_function (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1977 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1978 Lisp_Compiled_Function *f;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1979
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	1980 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	1981 f, &lrecord_compiled_function);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1982
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1983 f->stack_depth = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1984 f->specpdl_depth = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1985 f->flags.documentationp = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1986 f->flags.interactivep = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1987 f->flags.domainp = 0; /* I18N3 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1988 f->instructions = Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1989 f->constants = Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1990 f->arglist = Qnil;
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	1991 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	1992 f->arguments = Qnil;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	1993 #else /* not NEW_GC */
1739 9ddedfc70c4a [xemacs-hg @ 2003-10-10 18:04:23 by james] james parents: 1737 diff changeset	1994 f->args = NULL;
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	1995 #endif /* not NEW_GC */
1739 9ddedfc70c4a [xemacs-hg @ 2003-10-10 18:04:23 by james] james parents: 1737 diff changeset	1996 f->max_args = f->min_args = f->args_in_array = 0;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1997 f->doc_and_interactive = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1998 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1999 f->annotated = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2000 #endif
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2001 return wrap_compiled_function (f);
428 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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2004 DEFUN ("make-byte-code", Fmake_byte_code, 4, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2005 Return a new compiled-function object.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2006 Note that, unlike all other emacs-lisp functions, calling this with five
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2007 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	2008 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	2009 that this function was defined with `(interactive)'. If the arg is not
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2010 specified, then that means the function is not interactive.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2011 This is terrible behavior which is retained for compatibility with old
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2012 `.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	2013
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs. Aidan Kehoe <kehoea@parhasard.net> parents: 3514 diff changeset	2014 arguments: (ARGLIST INSTRUCTIONS CONSTANTS STACK-DEPTH &optional DOC-STRING INTERACTIVE)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2015 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2016 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2017 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2018 /* In a non-insane world this function would have this arglist...
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2019 (arglist instructions constants stack_depth &optional doc_string interactive)
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 Lisp_Object fun = make_compiled_function ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2022 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2023
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2024 Lisp_Object arglist = args[0];
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2025 Lisp_Object instructions = args[1];
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2026 Lisp_Object constants = args[2];
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2027 Lisp_Object stack_depth = args[3];
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2028 Lisp_Object doc_string = (nargs > 4) ? args[4] : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2029 Lisp_Object interactive = (nargs > 5) ? args[5] : Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2030
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2031 if (nargs < 4 \|\| nargs > 6)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2032 return Fsignal (Qwrong_number_of_arguments,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2033 list2 (intern ("make-byte-code"), make_int (nargs)));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2034
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2035 /* Check for valid formal parameter list now, to allow us to use
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2036 SPECBIND_FAST_UNSAFE() later in funcall_compiled_function(). */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2037 {
814 a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben] ben parents: 801 diff changeset	2038 EXTERNAL_LIST_LOOP_2 (symbol, arglist)
428 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_SYMBOL (symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2041 if (EQ (symbol, Qt) \|\|
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2042 EQ (symbol, Qnil) \|\|
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2043 SYMBOL_IS_KEYWORD (symbol))
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 551 diff changeset	2044 invalid_constant_2
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2045 ("Invalid constant symbol in formal parameter list",
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2046 symbol, arglist);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2047 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2048 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2049 f->arglist = arglist;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2050
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2051 /* `instructions' is a string or a cons (string . int) for a
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2052 lazy-loaded function. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2053 if (CONSP (instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2054 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2055 CHECK_STRING (XCAR (instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2056 CHECK_INT (XCDR (instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2057 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2058 else
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 CHECK_STRING (instructions);
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->instructions = instructions;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2063
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2064 if (!NILP (constants))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2065 CHECK_VECTOR (constants);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2066 f->constants = constants;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2067
5307 c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	2068 check_integer_range (stack_depth, Qzero, make_int (USHRT_MAX));
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2069 f->stack_depth = (unsigned short) XINT (stack_depth);
428 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 #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	2072 f->annotated = Vload_file_name_internal;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2073 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2074
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2075 /* doc_string may be nil, string, int, or a cons (string . int).
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2076 interactive may be list or string (or unbound). */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2077 f->doc_and_interactive = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2078 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2079 if ((f->flags.domainp = !NILP (Vfile_domain)) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2080 f->doc_and_interactive = Vfile_domain;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2081 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2082 if ((f->flags.interactivep = !UNBOUNDP (interactive)) != 0)
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 f->doc_and_interactive
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2085 = (UNBOUNDP (f->doc_and_interactive) ? interactive :
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2086 Fcons (interactive, f->doc_and_interactive));
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 if ((f->flags.documentationp = !NILP (doc_string)) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2089 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2090 f->doc_and_interactive
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2091 = (UNBOUNDP (f->doc_and_interactive) ? doc_string :
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2092 Fcons (doc_string, f->doc_and_interactive));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2093 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2094 if (UNBOUNDP (f->doc_and_interactive))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2095 f->doc_and_interactive = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2096
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2097 return fun;
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 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2102 /* Symbol allocation */
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
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2105 DECLARE_FIXED_TYPE_ALLOC (symbol, Lisp_Symbol);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2106 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_symbol 1000
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2107
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2108 DEFUN ("make-symbol", Fmake_symbol, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2109 Return a newly allocated uninterned symbol whose name is NAME.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2110 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	2111 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2112 (name))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2113 {
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2114 Lisp_Symbol *p;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2115
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2116 CHECK_STRING (name);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2117
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2118 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	2119 p->name = name;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2120 p->plist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2121 p->value = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2122 p->function = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2123 symbol_next (p) = 0;
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2124 return wrap_symbol (p);
428 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 /* Extent 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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2132 DECLARE_FIXED_TYPE_ALLOC (extent, struct extent);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2133 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_extent 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 struct extent *
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2136 allocate_extent (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2137 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2138 struct extent *e;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: 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 (extent, struct extent, e, &lrecord_extent);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2141 extent_object (e) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2142 set_extent_start (e, -1);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2143 set_extent_end (e, -1);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2144 e->plist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2145
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2146 xzero (e->flags);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2147
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2148 extent_face (e) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2149 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	2150 e->flags.detachable = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2151
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2152 return e;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2153 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2154
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2155
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2156 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2157 /* Event allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2158 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2159
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2160 DECLARE_FIXED_TYPE_ALLOC (event, Lisp_Event);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2161 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_event 1000
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2162
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2163 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2164 allocate_event (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2165 {
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2166 Lisp_Event *e;
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2167
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2168 ALLOC_FROB_BLOCK_LISP_OBJECT (event, Lisp_Event, e, &lrecord_event);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2169
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2170 return wrap_event (e);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2171 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2172
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2173 #ifdef EVENT_DATA_AS_OBJECTS
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2174 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	2175 #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	2176
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2177 Lisp_Object
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2178 make_key_data (void)
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2179 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2180 Lisp_Key_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2181
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2182 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	2183 &lrecord_key_data);
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2184 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	2185 d->keysym = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2186
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2187 return wrap_key_data (d);
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2188 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2189
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2190 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	2191 #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	2192
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2193 Lisp_Object
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2194 make_button_data (void)
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2195 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2196 Lisp_Button_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2197
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	2198 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	2199 &lrecord_button_data);
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2200 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	2201 return wrap_button_data (d);
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2202 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2203
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2204 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	2205 #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	2206
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2207 Lisp_Object
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2208 make_motion_data (void)
934 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_Motion_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2211
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	2212 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	2213 &lrecord_motion_data);
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2214 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	2215
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2216 return wrap_motion_data (d);
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2217 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2218
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2219 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	2220 #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	2221
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2222 Lisp_Object
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2223 make_process_data (void)
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2224 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2225 Lisp_Process_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2226
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	2227 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	2228 &lrecord_process_data);
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2229 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	2230 d->process = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2231
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2232 return wrap_process_data (d);
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2233 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2234
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2235 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	2236 #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	2237
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2238 Lisp_Object
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2239 make_timeout_data (void)
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2240 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2241 Lisp_Timeout_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2242
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	2243 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	2244 &lrecord_timeout_data);
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2245 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	2246 d->function = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2247 d->object = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2248
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2249 return wrap_timeout_data (d);
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2250 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2251
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2252 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	2253 #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	2254
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2255 Lisp_Object
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2256 make_magic_data (void)
934 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_Magic_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2259
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	2260 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	2261 &lrecord_magic_data);
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2262 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	2263
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2264 return wrap_magic_data (d);
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2265 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2266
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2267 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	2268 #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	2269
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2270 Lisp_Object
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2271 make_magic_eval_data (void)
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2272 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2273 Lisp_Magic_Eval_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2274
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	2275 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	2276 &lrecord_magic_eval_data);
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2277 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	2278 d->object = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2279
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2280 return wrap_magic_eval_data (d);
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2281 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2282
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2283 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	2284 #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	2285
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2286 Lisp_Object
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2287 make_eval_data (void)
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2288 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2289 Lisp_Eval_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2290
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	2291 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	2292 &lrecord_eval_data);
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2293 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	2294 d->function = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2295 d->object = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2296
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2297 return wrap_eval_data (d);
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2298 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2299
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2300 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	2301 #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	2302
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2303 Lisp_Object
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2304 make_misc_user_data (void)
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2305 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2306 Lisp_Misc_User_Data *d;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2307
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	2308 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	2309 &lrecord_misc_user_data);
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2310 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	2311 d->function = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2312 d->object = Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2313
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2314 return wrap_misc_user_data (d);
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	2315 }
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2316
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2317 #endif /* EVENT_DATA_AS_OBJECTS */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2318
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2319 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2320 /* Marker allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2321 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2322
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2323 DECLARE_FIXED_TYPE_ALLOC (marker, Lisp_Marker);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2324 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_marker 1000
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2325
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2326 DEFUN ("make-marker", Fmake_marker, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2327 Return a new marker which does not point at any place.
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 {
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2331 Lisp_Marker *p;
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2332
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2333 ALLOC_FROB_BLOCK_LISP_OBJECT (marker, Lisp_Marker, p, &lrecord_marker);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2334 p->buffer = 0;
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	2335 p->membpos = 0;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2336 marker_next (p) = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2337 marker_prev (p) = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2338 p->insertion_type = 0;
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2339 return wrap_marker (p);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2340 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2341
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2342 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2343 noseeum_make_marker (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2344 {
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2345 Lisp_Marker *p;
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2346
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2347 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	2348 &lrecord_marker);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2349 p->buffer = 0;
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	2350 p->membpos = 0;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2351 marker_next (p) = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2352 marker_prev (p) = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2353 p->insertion_type = 0;
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2354 return wrap_marker (p);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2355 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2356
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2357
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2358 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2359 /* String allocation */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2360 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2361
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2362 /* The data for "short" strings generally resides inside of structs of type
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2363 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	2364 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	2365 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	2366 large strings do not.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2367
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2368 Previously Lisp_String structures were relocated, but this caused a lot
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2369 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	2370 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	2371 that the reference would get relocated).
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2372
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2373 This new method makes things somewhat bigger, but it is MUCH safer. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2374
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2375 DECLARE_FIXED_TYPE_ALLOC (string, Lisp_String);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2376 /* strings are used and freed quite often */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2377 /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 10000 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2378 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 1000
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2379
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2380 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2381 mark_string (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2382 {
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2383 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	2384 flush_cached_extent_info (XCAR (XSTRING_PLIST (obj)));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2385 return XSTRING_PLIST (obj);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2386 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2387
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2388 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	2389 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	2390 int foldcase)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2391 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2392 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	2393 if (foldcase)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	2394 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	2395 else
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	2396 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	2397 !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2), len));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2398 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2399
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	2400 static const struct memory_description string_description[] = {
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2401 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2402 { XD_LISP_OBJECT, offsetof (Lisp_String, data_object) },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2403 #else /* not NEW_GC */
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2404 { XD_BYTECOUNT, offsetof (Lisp_String, size_) },
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2405 { 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	2406 #endif /* not NEW_GC */
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2407 { XD_LISP_OBJECT, offsetof (Lisp_String, plist) },
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2408 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2409 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2410
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2411 /* 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	2412 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	2413 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	2414 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	2415 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	2416 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	2417 extent info.
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2418
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2419 #### 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	2420
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2421 static Lisp_Object *
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2422 string_plist_ptr (Lisp_Object string)
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2423 {
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2424 Lisp_Object *ptr = &XSTRING_PLIST (string);
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2425
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2426 if (CONSP (ptr) && EXTENT_INFOP (XCAR (ptr)))
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2427 ptr = &XCDR (*ptr);
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2428 if (CONSP (ptr) && INTP (XCAR (ptr)))
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2429 ptr = &XCDR (*ptr);
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2430 return ptr;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2431 }
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2432
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2433 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2434 string_getprop (Lisp_Object string, Lisp_Object property)
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2435 {
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2436 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	2437 }
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2438
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2439 static int
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2440 string_putprop (Lisp_Object string, Lisp_Object property, Lisp_Object value)
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2441 {
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2442 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	2443 return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2444 }
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2445
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2446 static int
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2447 string_remprop (Lisp_Object string, Lisp_Object property)
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2448 {
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2449 return external_remprop (string_plist_ptr (string), property, 0, ERROR_ME);
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2450 }
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2451
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2452 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2453 string_plist (Lisp_Object string)
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2454 {
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2455 return *string_plist_ptr (string);
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2456 }
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2457
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	2458 #ifndef NEW_GC
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2459 /* No `finalize', or `hash' methods.
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2460 internal_hash() already knows how to hash strings and finalization
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2461 is done with the ADDITIONAL_FREE_string macro, which is the
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2462 standard way to do finalization when using
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	2463 SWEEP_FIXED_TYPE_BLOCK(). */
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	2464
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2465 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("string", string,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2466 mark_string, print_string,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2467 0, string_equal, 0,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2468 string_description,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2469 Lisp_String);
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	2470 #endif /* not NEW_GC */
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	2471
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2472 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2473 #define STRING_FULLSIZE(size) \
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2474 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	2475 #else /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2476 /* String blocks contain this many useful bytes. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2477 #define STRING_CHARS_BLOCK_SIZE \
814 a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben] ben parents: 801 diff changeset	2478 ((Bytecount) (8192 - MALLOC_OVERHEAD - \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben] ben parents: 801 diff changeset	2479 ((2 * sizeof (struct string_chars_block *)) \
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben] ben parents: 801 diff changeset	2480 + sizeof (EMACS_INT))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2481 /* Block header for small strings. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2482 struct string_chars_block
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2483 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2484 EMACS_INT pos;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2485 struct string_chars_block *next;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2486 struct string_chars_block *prev;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2487 /* Contents of string_chars_block->string_chars are interleaved
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2488 string_chars structures (see below) and the actual string data */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2489 unsigned char string_chars[STRING_CHARS_BLOCK_SIZE];
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2490 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2491
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2492 static struct string_chars_block *first_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2493 static struct string_chars_block *current_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2494
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2495 /* 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	2496 * the string occupies in string_chars_block->string_chars
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2497 * (including alignment padding).
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2498 */
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2499 #define STRING_FULLSIZE(size) \
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 814 diff changeset	2500 ALIGN_FOR_TYPE (((size) + 1 + sizeof (Lisp_String )), Lisp_String )
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2501
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2502 #define BIG_STRING_FULLSIZE_P(fullsize) ((fullsize) >= STRING_CHARS_BLOCK_SIZE)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2503 #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	2504
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	2505 #define STRING_CHARS_FREE_P(ptr) ((ptr)->string == NULL)
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	2506 #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	2507 #endif /* not NEW_GC */
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	2508
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	2509 #ifdef NEW_GC
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2510 DEFINE_DUMPABLE_LISP_OBJECT ("string", string, mark_string, print_string,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2511 0, string_equal, 0,
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2512 string_description, Lisp_String);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2513
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2514
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2515 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	2516 { 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	2517 { XD_END }
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 Bytecount
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2521 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	2522 {
a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2523 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	2524 }
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_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	2528 string_direct_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_direct_data_description,
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	2531 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	2532 Lisp_String_Direct_Data);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2533
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2534
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2535 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	2536 { XD_BYTECOUNT, offsetof (Lisp_String_Indirect_Data, size) },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2537 { 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	2538 XD_INDIRECT(0, 1) },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2539 { XD_END }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2540 };
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2541
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	2542 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	2543 string_indirect_data,
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	2544 0,
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	2545 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	2546 Lisp_String_Indirect_Data);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2547 #endif /* NEW_GC */
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	2548
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2549 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2550 struct string_chars
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2551 {
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2552 Lisp_String *string;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2553 unsigned char chars[1];
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2554 };
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 struct unused_string_chars
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2557 {
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2558 Lisp_String *string;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2559 EMACS_INT fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2560 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2561
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2562 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2563 init_string_chars_alloc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2564 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2565 first_string_chars_block = xnew (struct string_chars_block);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2566 first_string_chars_block->prev = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2567 first_string_chars_block->next = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2568 first_string_chars_block->pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2569 current_string_chars_block = first_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2570 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2571
1550 6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent] stephent parents: 1346 diff changeset	2572 static Ibyte *
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent] stephent parents: 1346 diff changeset	2573 allocate_big_string_chars (Bytecount length)
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent] stephent parents: 1346 diff changeset	2574 {
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent] stephent parents: 1346 diff changeset	2575 Ibyte *p = xnew_array (Ibyte, length);
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent] stephent parents: 1346 diff changeset	2576 INCREMENT_CONS_COUNTER (length, "string chars");
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent] stephent parents: 1346 diff changeset	2577 return p;
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent] stephent parents: 1346 diff changeset	2578 }
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent] stephent parents: 1346 diff changeset	2579
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2580 static struct string_chars *
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2581 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	2582 Bytecount fullsize)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2583 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2584 struct string_chars *s_chars;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2585
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2586 if (fullsize <=
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2587 (countof (current_string_chars_block->string_chars)
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2588 - current_string_chars_block->pos))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2589 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2590 /* This string can fit in the current string chars block */
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 + current_string_chars_block->pos);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2594 current_string_chars_block->pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2595 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2596 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2597 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2598 /* Make a new current string chars block */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2599 struct string_chars_block *new_scb = xnew (struct string_chars_block);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2600
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2601 current_string_chars_block->next = new_scb;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2602 new_scb->prev = current_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2603 new_scb->next = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2604 current_string_chars_block = new_scb;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2605 new_scb->pos = fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2606 s_chars = (struct string_chars *)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2607 current_string_chars_block->string_chars;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2608 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2609
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2610 s_chars->string = XSTRING (string_it_goes_with);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2611
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2612 INCREMENT_CONS_COUNTER (fullsize, "string chars");
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2613
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2614 return s_chars;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2615 }
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2616 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2617
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2618 #ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2619 void
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2620 sledgehammer_check_ascii_begin (Lisp_Object str)
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 Bytecount i;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2623
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2624 for (i = 0; i < XSTRING_LENGTH (str); i++)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2625 {
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 814 diff changeset	2626 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	2627 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2628 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2629
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2630 assert (i == (Bytecount) XSTRING_ASCII_BEGIN (str) \|\|
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2631 (i > MAX_STRING_ASCII_BEGIN &&
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2632 (Bytecount) XSTRING_ASCII_BEGIN (str) ==
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2633 (Bytecount) MAX_STRING_ASCII_BEGIN));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2634 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2635 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2636
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2637 /* 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	2638 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	2639 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	2640
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2641 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2642 make_uninit_string (Bytecount length)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2643 {
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2644 Lisp_String *s;
814 a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben] ben parents: 801 diff changeset	2645 Bytecount fullsize = STRING_FULLSIZE (length);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2646
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2647 assert (length >= 0 && fullsize > 0);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2648
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	2649 #ifdef NEW_GC
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	2650 s = XSTRING (ALLOC_NORMAL_LISP_OBJECT (string));
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	2651 #else /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2652 /* Allocate the string header */
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2653 ALLOCATE_FIXED_TYPE (string, Lisp_String, s);
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2654 xzero (*s);
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2655 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	2656 #endif /* not NEW_GC */
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	2657
3063 d30cd499e445 [xemacs-hg @ 2005-11-13 10:48:01 by ben] ben parents: 3024 diff changeset	2658 /* 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	2659 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	2660 XSET_STRING_ASCII_BEGIN (wrap_string (s), 0);
d30cd499e445 [xemacs-hg @ 2005-11-13 10:48:01 by ben] ben parents: 3024 diff changeset	2661
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2662 #ifdef NEW_GC
3304 73051095a712 [xemacs-hg @ 2006-03-26 14:33:37 by crestani] crestani parents: 3263 diff changeset	2663 set_lispstringp_direct (s);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2664 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	2665 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	2666 #else /* not NEW_GC */
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 814 diff changeset	2667 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	2668 ? allocate_big_string_chars (length + 1)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	2669 : allocate_string_chars_struct (wrap_string (s),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	2670 fullsize)->chars);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2671 #endif /* not NEW_GC */
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2672
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 814 diff changeset	2673 set_lispstringp_length (s, length);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2674 s->plist = Qnil;
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2675 set_string_byte (wrap_string (s), length, 0);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2676
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2677 return wrap_string (s);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2678 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2679
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2680 #ifdef VERIFY_STRING_CHARS_INTEGRITY
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2681 static void verify_string_chars_integrity (void);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2682 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2683
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2684 /* Resize the string S so that DELTA bytes can be inserted starting
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2685 at POS. If DELTA < 0, it means deletion starting at POS. If
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2686 POS < 0, resize the string but don't copy any characters. Use
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2687 this if you're planning on completely overwriting the string.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2688 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2689
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2690 void
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2691 resize_string (Lisp_Object s, Bytecount pos, Bytecount delta)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2692 {
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2693 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2694 Bytecount newfullsize, len;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2695 #else /* not NEW_GC */
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2696 Bytecount oldfullsize, newfullsize;
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2697 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2698 #ifdef VERIFY_STRING_CHARS_INTEGRITY
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2699 verify_string_chars_integrity ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2700 #endif
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	2701 #ifdef ERROR_CHECK_TEXT
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2702 if (pos >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2703 {
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2704 assert (pos <= XSTRING_LENGTH (s));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2705 if (delta < 0)
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2706 assert (pos + (-delta) <= XSTRING_LENGTH (s));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2707 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2708 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2709 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2710 if (delta < 0)
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2711 assert ((-delta) <= XSTRING_LENGTH (s));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2712 }
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	2713 #endif /* ERROR_CHECK_TEXT */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2714
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2715 if (delta == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2716 /* simplest case: no size change. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2717 return;
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2718
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2719 if (pos >= 0 && delta < 0)
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2720 /* If DELTA < 0, the functions below will delete the characters
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2721 before POS. We want to delete characters after POS, however,
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2722 so convert this to the appropriate form. */
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2723 pos += -delta;
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2724
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2725 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2726 newfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s) + delta);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2727
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2728 len = XSTRING_LENGTH (s) + 1 - pos;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2729
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2730 if (delta < 0 && pos >= 0)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2731 memmove (XSTRING_DATA (s) + pos + delta,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2732 XSTRING_DATA (s) + pos, len);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2733
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2734 XSTRING_DATA_OBJECT (s) =
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2735 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	2736 newfullsize));
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2737 if (delta > 0 && pos >= 0)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2738 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	2739 len);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2740
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	2741 #else /* not NEW_GC */
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2742 oldfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2743 newfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s) + delta);
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2744
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2745 if (BIG_STRING_FULLSIZE_P (oldfullsize))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2746 {
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2747 if (BIG_STRING_FULLSIZE_P (newfullsize))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2748 {
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2749 /* Both strings are big. We can just realloc().
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2750 But careful! If the string is shrinking, we have to
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2751 memmove() _before_ realloc(), and if growing, we have to
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2752 memmove() _after_ realloc() - otherwise the access is
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2753 illegal, and we might crash. */
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2754 Bytecount len = XSTRING_LENGTH (s) + 1 - pos;
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2755
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2756 if (delta < 0 && pos >= 0)
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2757 memmove (XSTRING_DATA (s) + pos + delta,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2758 XSTRING_DATA (s) + pos, len);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2759 XSET_STRING_DATA
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2760 (s, (Ibyte *) xrealloc (XSTRING_DATA (s),
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2761 XSTRING_LENGTH (s) + delta + 1));
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	2762 if (delta > 0 && pos >= 0)
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2763 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	2764 len);
1550 6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent] stephent parents: 1346 diff changeset	2765 /* Bump the cons counter.
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent] stephent parents: 1346 diff changeset	2766 Conservative; Martin let the increment be delta. */
6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent] stephent parents: 1346 diff changeset	2767 INCREMENT_CONS_COUNTER (newfullsize, "string chars");
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2768 }
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2769 else /* String has been demoted from BIG_STRING. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2770 {
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2771 Ibyte *new_data =
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2772 allocate_string_chars_struct (s, newfullsize)->chars;
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2773 Ibyte *old_data = XSTRING_DATA (s);
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2774
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2775 if (pos >= 0)
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2776 {
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2777 memcpy (new_data, old_data, pos);
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2778 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	2779 XSTRING_LENGTH (s) + 1 - pos);
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2780 }
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2781 XSET_STRING_DATA (s, new_data);
4976 16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO) Ben Wing <ben@xemacs.org> parents: 4969 diff changeset	2782 xfree (old_data);
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2783 }
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2784 }
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2785 else /* old string is small */
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2786 {
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2787 if (oldfullsize == newfullsize)
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2788 {
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2789 /* special case; size change but the necessary
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2790 allocation size won't change (up or down; code
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2791 somewhere depends on there not being any unused
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2792 allocation space, modulo any alignment
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2793 constraints). */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2794 if (pos >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2795 {
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2796 Ibyte *addroff = pos + XSTRING_DATA (s);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2797
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2798 memmove (addroff + delta, addroff,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2799 /* +1 due to zero-termination. */
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2802 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2803 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2804 {
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2805 Ibyte *old_data = XSTRING_DATA (s);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2806 Ibyte *new_data =
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2807 BIG_STRING_FULLSIZE_P (newfullsize)
1550 6e7ace1ab32d [xemacs-hg @ 2003-06-30 09:38:38 by stephent] stephent parents: 1346 diff changeset	2808 ? allocate_big_string_chars (XSTRING_LENGTH (s) + delta + 1)
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2809 : allocate_string_chars_struct (s, newfullsize)->chars;
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2810
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2811 if (pos >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2812 {
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2813 memcpy (new_data, old_data, pos);
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2814 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	2815 XSTRING_LENGTH (s) + 1 - pos);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2816 }
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2817 XSET_STRING_DATA (s, new_data);
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2818
4776 73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string() Aidan Kehoe <kehoea@parhasard.net> parents: 4735 diff changeset	2819 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	2820 {
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string() Aidan Kehoe <kehoea@parhasard.net> parents: 4735 diff changeset	2821 /* 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	2822 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	2823 freak. */
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string() Aidan Kehoe <kehoea@parhasard.net> parents: 4735 diff changeset	2824 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	2825 ((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	2826 /* 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	2827 alignment/padding. */
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string() Aidan Kehoe <kehoea@parhasard.net> parents: 4735 diff changeset	2828 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	2829 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	2830 ((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	2831 oldfullsize;
73e8632018ad Don't attempt to free dumped data, alloc.c:resize_string() Aidan Kehoe <kehoea@parhasard.net> parents: 4735 diff changeset	2832 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2833 }
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2834 }
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	2835 #endif /* not NEW_GC */
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2836
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2837 XSET_STRING_LENGTH (s, XSTRING_LENGTH (s) + delta);
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2838 /* If pos < 0, the string won't be zero-terminated.
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2839 Terminate now just to make sure. */
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2840 XSTRING_DATA (s)[XSTRING_LENGTH (s)] = '\0';
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2841
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	2842 if (pos >= 0)
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2843 /* 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	2844 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	2845 adjust_extents() is exclusive of the starting position
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2846 passed to it. */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2847 adjust_extents (s, pos - 1, XSTRING_LENGTH (s), delta);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2848
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2849 #ifdef VERIFY_STRING_CHARS_INTEGRITY
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2850 verify_string_chars_integrity ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2851 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2852 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2853
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2854 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2855
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2856 /* 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	2857 CHECK_LISP_WRITEABLE() before and bump_string_modiff() afterwards. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2858 void
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2859 set_string_char (Lisp_Object s, Charcount i, Ichar c)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2860 {
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2861 Ibyte newstr[MAX_ICHAR_LEN];
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2862 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	2863 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	2864 Bytecount newlen = set_itext_ichar (newstr, c);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2865
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2866 sledgehammer_check_ascii_begin (s);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2867 if (oldlen != newlen)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2868 resize_string (s, bytoff, newlen - oldlen);
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2869 /* 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	2870 memcpy (XSTRING_DATA (s) + bytoff, newstr, newlen);
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2871 if (oldlen != newlen)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2872 {
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2873 if (newlen > 1 && i <= (Charcount) XSTRING_ASCII_BEGIN (s))
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2874 /* 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	2875 ascii_begin */
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2876 XSET_STRING_ASCII_BEGIN (s, i);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2877 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	2878 /* 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	2879 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2880 Bytecount j;
814 a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben] ben parents: 801 diff changeset	2881 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	2882 {
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 814 diff changeset	2883 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	2884 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2885 }
814 a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben] ben parents: 801 diff changeset	2886 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	2887 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2888 }
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2889 sledgehammer_check_ascii_begin (s);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2890 }
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 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2893
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2894 DEFUN ("make-string", Fmake_string, 2, 2, 0, /*
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	2895 Return a new string consisting of LENGTH copies of CHARACTER.
576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	2896 LENGTH must be a non-negative integer.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2897 */
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	2898 (length, character))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2899 {
5307 c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	2900 check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT));
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	2901 CHECK_CHAR_COERCE_INT (character);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2902 {
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2903 Ibyte init_str[MAX_ICHAR_LEN];
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2904 int len = set_itext_ichar (init_str, XCHAR (character));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2905 Lisp_Object val = make_uninit_string (len * XINT (length));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2906
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2907 if (len == 1)
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2908 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2909 /* Optimize the single-byte case */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2910 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	2911 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	2912 len * XINT (length)));
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2913 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2914 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2915 {
647 b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben] ben parents: 617 diff changeset	2916 EMACS_INT i;
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2917 Ibyte *ptr = XSTRING_DATA (val);
428 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 for (i = XINT (length); i; i--)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2920 {
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2921 Ibyte *init_ptr = init_str;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2922 switch (len)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2923 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2924 case 4: ptr++ = init_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2925 case 3: ptr++ = init_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2926 case 2: ptr++ = init_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2927 case 1: ptr++ = init_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2928 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2929 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2930 }
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2931 sledgehammer_check_ascii_begin (val);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2932 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2933 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2934 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2935
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2936 DEFUN ("string", Fstring, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2937 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	2938
80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs. Aidan Kehoe <kehoea@parhasard.net> parents: 3514 diff changeset	2939 arguments: (&rest ARGS)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2940 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2941 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2942 {
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	2943 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	2944 Ibyte *p = storage;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2945
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2946 for (; nargs; nargs--, args++)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2947 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2948 Lisp_Object lisp_char = *args;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2949 CHECK_CHAR_COERCE_INT (lisp_char);
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2950 p += set_itext_ichar (p, XCHAR (lisp_char));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2951 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2952 return make_string (storage, p - storage);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2953 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2954
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2955 /* 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	2956
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2957 void
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2958 init_string_ascii_begin (Lisp_Object string)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2959 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2960 #ifdef MULE
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2961 int i;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2962 Bytecount length = XSTRING_LENGTH (string);
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2963 Ibyte *contents = XSTRING_DATA (string);
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2964
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2965 for (i = 0; i < length; i++)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2966 {
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 814 diff changeset	2967 if (!byte_ascii_p (contents[i]))
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2968 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2969 }
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2970 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	2971 #else
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	2972 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	2973 MAX_STRING_ASCII_BEGIN));
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2974 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2975 sledgehammer_check_ascii_begin (string);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2976 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2977
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2978 /* Take some raw memory, which MUST already be in internal format,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2979 and package it up into a Lisp string. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2980 Lisp_Object
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	2981 make_string (const Ibyte *contents, Bytecount length)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2982 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2983 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2984
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2985 /* 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	2986 #if defined (ERROR_CHECK_TEXT) && defined (MULE)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2987 bytecount_to_charcount (contents, length); /* Just for the assertions */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2988 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2989
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2990 val = make_uninit_string (length);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2991 memcpy (XSTRING_DATA (val), contents, length);
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2992 init_string_ascii_begin (val);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	2993 sledgehammer_check_ascii_begin (val);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2994 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2995 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2996
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2997 /* Take some raw memory, encoded in some external data format,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2998 and convert it into a Lisp string. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2999 Lisp_Object
4953 304aebb79cd3 function renamings to track names of char typedefs Ben Wing <ben@xemacs.org> parents: 4952 diff changeset	3000 make_extstring (const Extbyte *contents, EMACS_INT length,
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	3001 Lisp_Object coding_system)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3002 {
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	3003 Lisp_Object string;
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	3004 TO_INTERNAL_FORMAT (DATA, (contents, length),
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	3005 LISP_STRING, string,
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	3006 coding_system);
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	3007 return string;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3008 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3009
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3010 Lisp_Object
4953 304aebb79cd3 function renamings to track names of char typedefs Ben Wing <ben@xemacs.org> parents: 4952 diff changeset	3011 build_istring (const Ibyte *str)
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3012 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3013 /* 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	3014 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	3015 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3016
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3017 Lisp_Object
4953 304aebb79cd3 function renamings to track names of char typedefs Ben Wing <ben@xemacs.org> parents: 4952 diff changeset	3018 build_cistring (const CIbyte *str)
304aebb79cd3 function renamings to track names of char typedefs Ben Wing <ben@xemacs.org> parents: 4952 diff changeset	3019 {
304aebb79cd3 function renamings to track names of char typedefs Ben Wing <ben@xemacs.org> parents: 4952 diff changeset	3020 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	3021 }
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3022
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3023 Lisp_Object
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3024 build_ascstring (const Ascbyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3025 {
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3026 ASSERT_ASCTEXT_ASCII (str);
4953 304aebb79cd3 function renamings to track names of char typedefs Ben Wing <ben@xemacs.org> parents: 4952 diff changeset	3027 return build_istring ((const Ibyte *) str);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3028 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3029
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3030 Lisp_Object
4953 304aebb79cd3 function renamings to track names of char typedefs Ben Wing <ben@xemacs.org> parents: 4952 diff changeset	3031 build_extstring (const Extbyte *str, Lisp_Object coding_system)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3032 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3033 /* 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	3034 return make_extstring ((const Extbyte *) str,
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	3035 (str ? dfc_external_data_len (str, coding_system) :
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	3036 0),
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	3037 coding_system);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3038 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3039
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3040 /* 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	3041 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	3042
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3043 Lisp_Object
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3044 build_msg_istring (const Ibyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3045 {
4953 304aebb79cd3 function renamings to track names of char typedefs Ben Wing <ben@xemacs.org> parents: 4952 diff changeset	3046 return build_istring (IGETTEXT (str));
4952 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
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3049 /* 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	3050 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	3051
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3052 Lisp_Object
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3053 build_msg_cistring (const CIbyte *str)
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 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	3056 }
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3057
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3058 /* 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	3059 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	3060 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	3061 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	3062
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3063 Lisp_Object
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3064 build_msg_ascstring (const Ascbyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3065 {
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3066 ASSERT_ASCTEXT_ASCII (str);
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3067 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	3068 }
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3069
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3070 /* 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	3071 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	3072 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	3073 translated.
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 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	3076 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	3077 properly. */
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3078
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3079 Lisp_Object
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3080 build_defer_istring (const Ibyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3081 {
4953 304aebb79cd3 function renamings to track names of char typedefs Ben Wing <ben@xemacs.org> parents: 4952 diff changeset	3082 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	3083 /* 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	3084 return retval;
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3085 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3086
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3087 Lisp_Object
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3088 build_defer_cistring (const CIbyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3089 {
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3090 return build_defer_istring ((Ibyte *) str);
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3091 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3092
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3093 Lisp_Object
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3094 build_defer_ascstring (const Ascbyte *str)
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3095 {
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3096 ASSERT_ASCTEXT_ASCII (str);
19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3097 return build_defer_istring ((Ibyte *) str);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3098 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3099
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3100 Lisp_Object
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	3101 make_string_nocopy (const Ibyte *contents, Bytecount length)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3102 {
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	3103 Lisp_String *s;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3104 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3105
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3106 /* 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	3107 #if defined (ERROR_CHECK_TEXT) && defined (MULE)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3108 bytecount_to_charcount (contents, length); /* Just for the assertions */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3109 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3110
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	3111 #ifdef NEW_GC
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	3112 s = XSTRING (ALLOC_NORMAL_LISP_OBJECT (string));
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3113 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	3114 collected and static data is tried to
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3115 be freed. */
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	3116 #else /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3117 /* Allocate the string header */
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	3118 ALLOCATE_FIXED_TYPE (string, Lisp_String, s);
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3119 set_lheader_implementation (&s->u.lheader, &lrecord_string);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3120 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	3121 #endif /* not NEW_GC */
3063 d30cd499e445 [xemacs-hg @ 2005-11-13 10:48:01 by ben] ben parents: 3024 diff changeset	3122 /* 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	3123 init_string_ascii_begin(). */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3124 s->plist = Qnil;
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	3125 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	3126 set_lispstringp_indirect (s);
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	3127 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	3128 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	3129 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	3130 #else /* not NEW_GC */
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	3131 set_lispstringp_data (s, (Ibyte *) contents);
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 814 diff changeset	3132 set_lispstringp_length (s, length);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	3133 #endif /* not NEW_GC */
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	3134 val = wrap_string (s);
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3135 init_string_ascii_begin (val);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3136 sledgehammer_check_ascii_begin (val);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3137
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3138 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3139 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3140
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3141
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	3142 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3143 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3144 /* lcrecord lists */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3145 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3146
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3147 /* 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	3148 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	3149 malloc() and garbage-collection junk) as much as possible.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3150 It is similar to the Blocktype class.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3151
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3152 See detailed comment in lcrecord.h.
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3153 */
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3154
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3155 const struct memory_description free_description[] = {
2551 9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james] james parents: 2532 diff changeset	3156 { 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	3157 XD_FLAG_FREE_LISP_OBJECT },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3158 { XD_END }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3159 };
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3160
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	3161 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	3162 struct free_lcrecord_header);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3163
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3164 const struct memory_description lcrecord_list_description[] = {
2551 9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james] james parents: 2532 diff changeset	3165 { 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	3166 XD_FLAG_FREE_LISP_OBJECT },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3167 { XD_END }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3168 };
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3169
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3170 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3171 mark_lcrecord_list (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3172 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3173 struct lcrecord_list *list = XLCRECORD_LIST (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3174 Lisp_Object chain = list->free;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3175
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3176 while (!NILP (chain))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3177 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3178 struct lrecord_header *lheader = XRECORD_LHEADER (chain);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3179 struct free_lcrecord_header *free_header =
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3180 (struct free_lcrecord_header *) lheader;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3181
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3182 gc_checking_assert
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3183 (/* There should be no other pointers to the free list. */
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3184 ! MARKED_RECORD_HEADER_P (lheader)
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3185 &&
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3186 /* Only lcrecords should be here. */
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	3187 ! list->implementation->frob_block_p
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3188 &&
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3189 /* 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	3190 lheader->free
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3191 &&
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3192 /* 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	3193 lheader->type == lrecord_type_free
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3194 &&
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3195 /* So must the size. */
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3196 (list->implementation->static_size == 0 \|\|
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3197 list->implementation->static_size == list->size)
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3198 );
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3199
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3200 MARK_RECORD_HEADER (lheader);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3201 chain = free_header->chain;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3202 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3203
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3204 return Qnil;
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
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	3207 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	3208 mark_lcrecord_list,
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	3209 lcrecord_list_description,
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4776 diff changeset	3210 struct lcrecord_list);
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	3211
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3212 Lisp_Object
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	3213 make_lcrecord_list (Elemcount size,
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3214 const struct lrecord_implementation *implementation)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3215 {
5124 623d57b7fbe8 separate regular and disksave finalization, print method fixes. Ben Wing <ben@xemacs.org> parents: 5120 diff changeset	3216 /* 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	3217 allocating this. */
5151 641d0cdd1d00 fix compilation problems identified by Robert Delius Royar Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	3218 struct lcrecord_list *p =
641d0cdd1d00 fix compilation problems identified by Robert Delius Royar Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	3219 XLCRECORD_LIST (old_alloc_lcrecord (&lrecord_lcrecord_list));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3220
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3221 p->implementation = implementation;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3222 p->size = size;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3223 p->free = Qnil;
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	3224 return wrap_lcrecord_list (p);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3225 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3226
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3227 Lisp_Object
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3228 alloc_managed_lcrecord (Lisp_Object lcrecord_list)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3229 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3230 struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3231 if (!NILP (list->free))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3232 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3233 Lisp_Object val = list->free;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3234 struct free_lcrecord_header *free_header =
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3235 (struct free_lcrecord_header *) XPNTR (val);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3236 struct lrecord_header *lheader = &free_header->lcheader.lheader;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3237
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3238 #ifdef ERROR_CHECK_GC
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3239 /* Major overkill here. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3240 /* There should be no other pointers to the free list. */
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3241 assert (! MARKED_RECORD_HEADER_P (lheader));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3242 /* 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	3243 assert (lheader->free);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3244 assert (lheader->type == lrecord_type_free);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3245 /* Only lcrecords should be here. */
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	3246 assert (! (list->implementation->frob_block_p));
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3247 #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	3248 lrecord_type_free. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3249 /* The type of the lcrecord must be right. */
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3250 assert (LHEADER_IMPLEMENTATION (lheader) == list->implementation);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3251 #endif /* 0 */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3252 /* So must the size. */
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3253 assert (list->implementation->static_size == 0 \|\|
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3254 list->implementation->static_size == list->size);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3255 #endif /* ERROR_CHECK_GC */
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3256
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3257 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	3258 lheader->free = 0;
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3259 /* 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	3260 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	3261 zero_sized_lisp_object (val, list->size);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3262 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3263 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3264 else
5151 641d0cdd1d00 fix compilation problems identified by Robert Delius Royar Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	3265 return old_alloc_sized_lcrecord (list->size, list->implementation);
428 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
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3268 /* "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	3269 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	3270 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	3271 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	3272 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	3273 used!
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3274
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3275 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	3276 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	3277
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3278 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3279 free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3280 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3281 struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3282 struct free_lcrecord_header *free_header =
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3283 (struct free_lcrecord_header *) XPNTR (lcrecord);
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3284 struct lrecord_header *lheader = &free_header->lcheader.lheader;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3285 const struct lrecord_implementation *implementation
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3286 = LHEADER_IMPLEMENTATION (lheader);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3287
4880 ae81a2c00f4f try harder to avoid crashing when debug-printing Ben Wing <ben@xemacs.org> parents: 4803 diff changeset	3288 /* 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	3289 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	3290 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	3291 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	3292 super long-lived afterwards, anyway. */
ae81a2c00f4f try harder to avoid crashing when debug-printing Ben Wing <ben@xemacs.org> parents: 4803 diff changeset	3293 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	3294 return;
ae81a2c00f4f try harder to avoid crashing when debug-printing Ben Wing <ben@xemacs.org> parents: 4803 diff changeset	3295
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3296 /* 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	3297 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	3298 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	3299 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	3300 (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	3301 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	3302 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	3303 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	3304 problems. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3305 gc_checking_assert (!gc_in_progress);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3306
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3307 /* Make sure the size is correct. This will catch, for example,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3308 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	3309 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	3310 /* 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	3311 gc_checking_assert (!lheader->free);
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	3312 /* 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	3313 may need to check for this before freeing. */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2286 diff changeset	3314 gc_checking_assert (!OBJECT_DUMPED_P (lcrecord));
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3315
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3316 if (implementation->finalizer)
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	3317 implementation->finalizer (lcrecord);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3318 /* 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	3319 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	3320 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	3321 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	3322 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	3323 MARK_LRECORD_AS_FREE (lheader);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3324 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	3325 lheader->free = 1;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3326 list->free = lcrecord;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3327 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3328
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3329 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	3330
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	3331 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	3332 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	3333 const struct lrecord_implementation *imp)
771 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 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	3336 all_lcrecord_lists[imp->lrecord_type_index] =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3337 make_lcrecord_list (size, imp);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3338
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	3339 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	3340 }
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	3341
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	3342 Lisp_Object
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	3343 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	3344 {
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3063 diff changeset	3345 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	3346 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	3347 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3348
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3349 void
3024 b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	3350 old_free_lcrecord (Lisp_Object rec)
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3351 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3352 int type = XRECORD_LHEADER (rec)->type;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3353
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3354 assert (!EQ (all_lcrecord_lists[type], Qzero));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3355
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3356 free_managed_lcrecord (all_lcrecord_lists[type], rec);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3357 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	3358 #endif /* not NEW_GC */
428 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 /************************************************************************/
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3362 /* Staticpro, MCpro */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3363 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3364
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3365 /* 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	3366 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	3367 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	3368 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	3369 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	3370 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	3371 "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	3372 static const struct memory_description staticpro_description_1[] = {
452 3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3373 { XD_END }
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3374 };
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3375
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3376 static const struct sized_memory_description staticpro_description = {
452 3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3377 sizeof (Lisp_Object *),
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3378 staticpro_description_1
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3379 };
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3380
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3381 static const struct memory_description staticpros_description_1[] = {
452 3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3382 XD_DYNARR_DESC (Lisp_Object_ptr_dynarr, &staticpro_description),
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3383 { XD_END }
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3384 };
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3385
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3386 static const struct sized_memory_description staticpros_description = {
452 3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3387 sizeof (Lisp_Object_ptr_dynarr),
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3388 staticpros_description_1
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3389 };
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3390
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3391 #ifdef DEBUG_XEMACS
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3392
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3393 /* 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	3394
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3395 Lisp_Object_ptr_dynarr *staticpros;
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3396 const_Ascbyte_ptr_dynarr *staticpro_names;
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3397
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3398 /* 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	3399 garbage collection, and for dumping. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3400 void
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3401 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	3402 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3403 Dynarr_add (staticpros, varaddress);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3404 Dynarr_add (staticpro_names, varname);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3405 dump_add_root_lisp_object (varaddress);
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3406 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3407
5016 2ade80e8c640 enable more warnings and fix them Ben Wing <ben@xemacs.org> parents: 4976 diff changeset	3408 const Ascbyte *staticpro_name (int count);
2ade80e8c640 enable more warnings and fix them Ben Wing <ben@xemacs.org> parents: 4976 diff changeset	3409
4934 714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3410 /* 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	3411 COUNT. */
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3412 const Ascbyte *
4934 714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3413 staticpro_name (int count)
714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3414 {
714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3415 return Dynarr_at (staticpro_names, count);
714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3416 }
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3417
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3418 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	3419 const_Ascbyte_ptr_dynarr *staticpro_nodump_names;
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3420
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3421 /* 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	3422 garbage collection, but not for dumping. (See below.) */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3423 void
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3424 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	3425 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3426 Dynarr_add (staticpros_nodump, varaddress);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3427 Dynarr_add (staticpro_nodump_names, varname);
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
5016 2ade80e8c640 enable more warnings and fix them Ben Wing <ben@xemacs.org> parents: 4976 diff changeset	3430 const Ascbyte *staticpro_nodump_name (int count);
2ade80e8c640 enable more warnings and fix them Ben Wing <ben@xemacs.org> parents: 4976 diff changeset	3431
4934 714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3432 /* 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	3433 COUNT. */
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3434 const Ascbyte *
4934 714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3435 staticpro_nodump_name (int count)
714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3436 {
714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3437 return Dynarr_at (staticpro_nodump_names, count);
714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3438 }
714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3439
996 25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3440 #ifdef HAVE_SHLIB
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3441 /* 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	3442 for garbage collection, but not for dumping. */
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3443 void
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3444 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	3445 {
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3446 Dynarr_delete_object (staticpros, varaddress);
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3447 Dynarr_delete_object (staticpro_names, varname);
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3448 }
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3449 #endif
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3450
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3451 #else /* not DEBUG_XEMACS */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3452
452 3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3453 Lisp_Object_ptr_dynarr *staticpros;
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3454
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3455 /* 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	3456 garbage collection, and for dumping. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3457 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3458 staticpro (Lisp_Object *varaddress)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3459 {
452 3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3460 Dynarr_add (staticpros, varaddress);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	3461 dump_add_root_lisp_object (varaddress);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3462 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3463
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3464
452 3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3465 Lisp_Object_ptr_dynarr *staticpros_nodump;
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3466
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3467 /* 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	3468 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	3469 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	3470 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	3471 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	3472 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	3473 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	3474 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	3475 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	3476 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	3477 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	3478 reloaded at a different address.)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3479
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3480 #### 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	3481 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	3482 loads the data in. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3483
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3484 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3485 staticpro_nodump (Lisp_Object *varaddress)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3486 {
452 3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	3487 Dynarr_add (staticpros_nodump, varaddress);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3488 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3489
996 25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3490 #ifdef HAVE_SHLIB
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3491 /* 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	3492 garbage collection, but not for dumping. */
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3493 void
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3494 unstaticpro_nodump (Lisp_Object *varaddress)
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3495 {
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3496 Dynarr_delete_object (staticpros, varaddress);
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3497 }
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3498 #endif
25e260cb7994 [xemacs-hg @ 2002-09-10 15:27:02 by james] james parents: 945 diff changeset	3499
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3500 #endif /* not DEBUG_XEMACS */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	3501
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	3502 #ifdef NEW_GC
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3503 static const struct memory_description mcpro_description_1[] = {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3504 { XD_END }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3505 };
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3506
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3507 static const struct sized_memory_description mcpro_description = {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3508 sizeof (Lisp_Object *),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3509 mcpro_description_1
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 static const struct memory_description mcpros_description_1[] = {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3513 XD_DYNARR_DESC (Lisp_Object_dynarr, &mcpro_description),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3514 { XD_END }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3515 };
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3516
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3517 static const struct sized_memory_description mcpros_description = {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3518 sizeof (Lisp_Object_dynarr),
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3519 mcpros_description_1
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3520 };
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3521
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3522 #ifdef DEBUG_XEMACS
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 /* 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	3525
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3526 Lisp_Object_dynarr *mcpros;
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3527 const_Ascbyte_ptr_dynarr *mcpro_names;
2720 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 /* 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	3530 garbage collection, and for dumping. */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3531 void
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3532 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	3533 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3534 Dynarr_add (mcpros, varaddress);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3535 Dynarr_add (mcpro_names, varname);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3536 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3537
5046 d4f666cda5e6 some random fixups Ben Wing <ben@xemacs.org> parents: 5016 diff changeset	3538 const Ascbyte *mcpro_name (int count);
d4f666cda5e6 some random fixups Ben Wing <ben@xemacs.org> parents: 5016 diff changeset	3539
4934 714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3540 /* 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	3541 COUNT. */
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	3542 const Ascbyte *
4934 714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3543 mcpro_name (int count)
714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3544 {
714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3545 return Dynarr_at (mcpro_names, count);
714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3546 }
714f7c9fabb1 make it easier to debug staticpro crashes. Ben Wing <ben@xemacs.org> parents: 4880 diff changeset	3547
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3548 #else /* not DEBUG_XEMACS */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3549
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3550 Lisp_Object_dynarr *mcpros;
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3551
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3552 /* 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	3553 garbage collection, and for dumping. */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3554 void
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3555 mcpro (Lisp_Object varaddress)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3556 {
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3557 Dynarr_add (mcpros, varaddress);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3558 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3559
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	3560 #endif /* not DEBUG_XEMACS */
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	3561 #endif /* NEW_GC */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	3562
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3563 #ifdef ALLOC_TYPE_STATS
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3564
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3565
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3566 /************************************************************************/
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3567 /* Determining allocation overhead */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3568 /************************************************************************/
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3569
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3570 /* Attempt to determine the actual amount of space that is used for
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3571 the block allocated starting at PTR, supposedly of size "CLAIMED_SIZE".
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3572
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3573 It seems that the following holds:
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3574
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3575 1. When using the old allocator (malloc.c):
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3576
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3577 -- blocks are always allocated in chunks of powers of two. For
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3578 each block, there is an overhead of 8 bytes if rcheck is not
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3579 defined, 20 bytes if it is defined. In other words, a
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3580 one-byte allocation needs 8 bytes of overhead for a total of
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3581 9 bytes, and needs to have 16 bytes of memory chunked out for
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3582 it.
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3583
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3584 2. When using the new allocator (gmalloc.c):
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3585
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3586 -- blocks are always allocated in chunks of powers of two up
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3587 to 4096 bytes. Larger blocks are allocated in chunks of
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3588 an integral multiple of 4096 bytes. The minimum block
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3589 size is 2sizeof (void ), or 16 bytes if SUNOS_LOCALTIME_BUG
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3590 is defined. There is no per-block overhead, but there
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3591 is an overhead of 3*sizeof (size_t) for each 4096 bytes
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3592 allocated.
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3593
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3594 3. When using the system malloc, anything goes, but they are
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3595 generally slower and more space-efficient than the GNU
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3596 allocators. One possibly reasonable assumption to make
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3597 for want of better data is that sizeof (void *), or maybe
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3598 2 * sizeof (void *), is required as overhead and that
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3599 blocks are allocated in the minimum required size except
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3600 that some minimum block size is imposed (e.g. 16 bytes). */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3601
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3602 Bytecount
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3603 malloced_storage_size (void * UNUSED (ptr), Bytecount claimed_size,
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3604 struct usage_stats *stats)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3605 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3606 Bytecount orig_claimed_size = claimed_size;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3607
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3608 #ifndef SYSTEM_MALLOC
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3609 if (claimed_size < (Bytecount) (2 * sizeof (void *)))
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3610 claimed_size = 2 * sizeof (void *);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3611 # ifdef SUNOS_LOCALTIME_BUG
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3612 if (claimed_size < 16)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3613 claimed_size = 16;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3614 # endif
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3615 if (claimed_size < 4096)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3616 {
5384 3889ef128488 Fix misspelled words, and some grammar, across the entire source tree. Jerry James <james@xemacs.org> parents: 5354 diff changeset	3617 /* fxg: rename log->log2 to suppress gcc3 shadow warning */
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3618 int log2 = 1;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3619
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3620 /* compute the log base two, more or less, then use it to compute
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3621 the block size needed. */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3622 claimed_size--;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3623 /* It's big, it's heavy, it's wood! */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3624 while ((claimed_size /= 2) != 0)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3625 ++log2;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3626 claimed_size = 1;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3627 /* It's better than bad, it's good! */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3628 while (log2 > 0)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3629 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3630 claimed_size *= 2;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3631 log2--;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3632 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3633 /* We have to come up with some average about the amount of
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3634 blocks used. */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3635 if ((Bytecount) (rand () & 4095) < claimed_size)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3636 claimed_size += 3 * sizeof (void *);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3637 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3638 else
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3639 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3640 claimed_size += 4095;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3641 claimed_size &= ~4095;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3642 claimed_size += (claimed_size / 4096) * 3 * sizeof (size_t);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3643 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3644
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3645 #else
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3646
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3647 if (claimed_size < 16)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3648 claimed_size = 16;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3649 claimed_size += 2 * sizeof (void *);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3650
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3651 #endif /* system allocator */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3652
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3653 if (stats)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3654 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3655 stats->was_requested += orig_claimed_size;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3656 stats->malloc_overhead += claimed_size - orig_claimed_size;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3657 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3658 return claimed_size;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3659 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3660
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3661 #ifndef NEW_GC
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3662 static Bytecount
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3663 fixed_type_block_overhead (Bytecount size, Bytecount per_block)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3664 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3665 Bytecount overhead = 0;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3666 Bytecount storage_size = malloced_storage_size (0, per_block, 0);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3667 while (size >= per_block)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3668 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3669 size -= per_block;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3670 overhead += storage_size - per_block;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3671 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3672 if (rand () % per_block < size)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3673 overhead += storage_size - per_block;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3674 return overhead;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3675 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3676 #endif /* not NEW_GC */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3677
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3678 Bytecount
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3679 lisp_object_storage_size (Lisp_Object obj, struct usage_stats *ustats)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3680 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3681 #ifndef NEW_GC
5179 14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	3682 const struct lrecord_implementation *imp;
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3683 #endif /* not NEW_GC */
5179 14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	3684 Bytecount size;
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	3685
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	3686 if (!LRECORDP (obj))
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	3687 return 0;
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	3688
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	3689 size = lisp_object_size (obj);
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3690
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3691 #ifdef NEW_GC
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3692 return mc_alloced_storage_size (size, ustats);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3693 #else
5179 14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	3694 imp = XRECORD_LHEADER_IMPLEMENTATION (obj);
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3695 if (imp->frob_block_p)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3696 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3697 Bytecount overhead =
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3698 /* #### Always using cons_block is incorrect but close; only
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3699 string_chars_block is significantly different in size, and
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3700 it won't ever be seen in this function */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3701 fixed_type_block_overhead (size, sizeof (struct cons_block));
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3702 if (ustats)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3703 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3704 ustats->was_requested += size;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3705 ustats->malloc_overhead += overhead;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3706 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3707 return size + overhead;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3708 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3709 else
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3710 return malloced_storage_size (XPNTR (obj), size, ustats);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3711 #endif
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3712 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3713
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3714
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3715 /************************************************************************/
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3716 /* Allocation Statistics: Accumulate */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3717 /************************************************************************/
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3718
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3719 #ifdef NEW_GC
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3720
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3721 void
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3722 init_lrecord_stats (void)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3723 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3724 xzero (lrecord_stats);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3725 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3726
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3727 void
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3728 inc_lrecord_stats (Bytecount size, const struct lrecord_header *h)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3729 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3730 int type_index = h->type;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3731 if (!size)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3732 size = detagged_lisp_object_size (h);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3733
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3734 lrecord_stats[type_index].instances_in_use++;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3735 lrecord_stats[type_index].bytes_in_use += size;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3736 lrecord_stats[type_index].bytes_in_use_including_overhead
5158 9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3737 #ifdef MEMORY_USAGE_STATS
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3738 += mc_alloced_storage_size (size, 0);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3739 #else /* not MEMORY_USAGE_STATS */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3740 += size;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3741 #endif /* not MEMORY_USAGE_STATS */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3742 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3743
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3744 void
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3745 dec_lrecord_stats (Bytecount size_including_overhead,
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3746 const struct lrecord_header *h)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3747 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3748 int type_index = h->type;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3749 int size = detagged_lisp_object_size (h);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3750
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3751 lrecord_stats[type_index].instances_in_use--;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3752 lrecord_stats[type_index].bytes_in_use -= size;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3753 lrecord_stats[type_index].bytes_in_use_including_overhead
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3754 -= size_including_overhead;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3755
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3756 DECREMENT_CONS_COUNTER (size);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3757 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3758
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3759 int
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3760 lrecord_stats_heap_size (void)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3761 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3762 int i;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3763 int size = 0;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3764 for (i = 0; i < countof (lrecord_implementations_table); i++)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3765 size += lrecord_stats[i].bytes_in_use;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3766 return size;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3767 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3768
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3769 #else /* not NEW_GC */
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3770
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3771 static void
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3772 clear_lrecord_stats (void)
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3773 {
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3774 xzero (lrecord_stats);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3775 gc_count_num_short_string_in_use = 0;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3776 gc_count_string_total_size = 0;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3777 gc_count_short_string_total_size = 0;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3778 gc_count_long_string_storage_including_overhead = 0;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3779 }
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3780
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3781 /* Keep track of extra statistics for strings -- length of the string
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3782 characters for short and long strings, number of short and long strings. */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3783 static void
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3784 tick_string_stats (Lisp_String *p, int from_sweep)
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3785 {
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3786 Bytecount size = p->size_;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3787 gc_count_string_total_size += size;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3788 if (!BIG_STRING_SIZE_P (size))
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3789 {
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3790 gc_count_short_string_total_size += size;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3791 gc_count_num_short_string_in_use++;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3792 }
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3793 else
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3794 gc_count_long_string_storage_including_overhead +=
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3795 malloced_storage_size (p->data_, p->size_, NULL);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3796 /* During the sweep stage, we count the total number of strings in use.
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3797 This gets those not stored in pdump storage. For pdump storage, we
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3798 need to bump the number of strings in use so as to get an accurate
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3799 count of all strings in use (pdump or not). But don't do this when
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3800 called from the sweep stage, or we will double-count. */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3801 if (!from_sweep)
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3802 gc_count_num_string_in_use++;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3803 }
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3804
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3805 /* As objects are sweeped, we record statistics about their memory usage.
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3806 Currently, all lcrecords are processed this way as well as any frob-block
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3807 objects that were saved and restored as a result of the pdump process.
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3808 (See pdump_objects_unmark().) Other frob-block objects do NOT get their
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3809 statistics noted this way -- instead, as the frob blocks are swept,
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3810 COPY_INTO_LRECORD_STATS() is called, and notes statistics about the
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3811 frob blocks. */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3812
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3813 void
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3814 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	3815 enum lrecord_alloc_status status)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3816 {
647 b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben] ben parents: 617 diff changeset	3817 int type_index = h->type;
5163 57f4dcb14ad5 Don't assume a Lisp_Object will fit in a Bytecount, src/alloc.c Aidan Kehoe <kehoea@parhasard.net> parents: 5160 diff changeset	3818 Lisp_Object obj = wrap_pointer_1 (h);
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3819 Bytecount sz = lisp_object_size (obj);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3820 Bytecount sz_with_overhead = lisp_object_storage_size (obj, NULL);
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3821 Bytecount overhead = sz_with_overhead - sz;
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3822
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3823 switch (status)
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3824 {
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3825 case ALLOC_IN_USE:
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3826 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	3827 lrecord_stats[type_index].bytes_in_use += sz;
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3828 lrecord_stats[type_index].bytes_in_use_overhead += overhead;
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3829 if (STRINGP (obj))
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3830 tick_string_stats (XSTRING (obj), 0);
5158 9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3831 #ifdef MEMORY_USAGE_STATS
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3832 {
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3833 struct generic_usage_stats stats;
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3834 if (HAS_OBJECT_METH_P (obj, memory_usage))
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3835 {
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3836 int i;
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3837 int total_stats = OBJECT_PROPERTY (obj, num_extra_memusage_stats);
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3838 xzero (stats);
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3839 OBJECT_METH (obj, memory_usage, (obj, &stats));
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3840 for (i = 0; i < total_stats; i++)
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3841 lrecord_stats[type_index].stats.othervals[i] +=
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3842 stats.othervals[i];
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3843 }
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3844 }
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	3845 #endif
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3846 break;
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3847 case ALLOC_FREE:
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3848 lrecord_stats[type_index].instances_freed++;
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3849 lrecord_stats[type_index].bytes_freed += sz;
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3850 lrecord_stats[type_index].bytes_freed_overhead += overhead;
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3851 break;
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3852 case ALLOC_ON_FREE_LIST:
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3853 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	3854 lrecord_stats[type_index].bytes_on_free_list += sz;
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3855 lrecord_stats[type_index].bytes_on_free_list_overhead += overhead;
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3856 break;
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3857 default:
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3858 ABORT ();
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3859 }
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3860 }
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3861
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3862 inline static void
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3863 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	3864 {
5142 f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object Ben Wing <ben@xemacs.org> parents: 5127 diff changeset	3865 if (h->free)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3866 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	3867 gc_checking_assert (!free_p);
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3868 tick_lrecord_stats (h, ALLOC_ON_FREE_LIST);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3869 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3870 else
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	3871 tick_lrecord_stats (h, free_p ? ALLOC_FREE : ALLOC_IN_USE);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3872 }
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	3873
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3874 #endif /* (not) NEW_GC */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3875
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3876 void
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3877 finish_object_memory_usage_stats (void)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3878 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3879 /* Here we add up the aggregate values for each statistic, previously
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3880 computed during tick_lrecord_stats(), to get a single combined value
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3881 of non-Lisp memory usage for all objects of each type. We can't
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3882 do this if NEW_GC because nothing like tick_lrecord_stats() gets
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3883 called -- instead, statistics are computed when objects are allocated,
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3884 which is too early to be calling the memory_usage() method. */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3885 #if defined (MEMORY_USAGE_STATS) && !defined (NEW_GC)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3886 int i;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3887 for (i = 0; i < countof (lrecord_implementations_table); i++)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3888 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3889 struct lrecord_implementation *imp = lrecord_implementations_table[i];
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3890 if (imp && imp->num_extra_nonlisp_memusage_stats)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3891 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3892 int j;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3893 for (j = 0; j < imp->num_extra_nonlisp_memusage_stats; j++)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3894 lrecord_stats[i].nonlisp_bytes_in_use +=
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3895 lrecord_stats[i].stats.othervals[j];
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3896 }
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	3897 if (imp && imp->num_extra_lisp_ancillary_memusage_stats)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	3898 {
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	3899 int j;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	3900 for (j = 0; j < imp->num_extra_lisp_ancillary_memusage_stats; j++)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	3901 lrecord_stats[i].lisp_ancillary_bytes_in_use +=
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	3902 lrecord_stats[i].stats.othervals
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	3903 [j + imp->offset_lisp_ancillary_memusage_stats];
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	3904 }
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3905 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3906 #endif /* defined (MEMORY_USAGE_STATS) && !defined (NEW_GC) */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3907 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3908
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3909 #define COUNT_FROB_BLOCK_USAGE(type) \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3910 EMACS_INT s = 0; \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3911 EMACS_INT s_overhead = 0; \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3912 struct type##_block *x = current_##type##_block; \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3913 while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3914 s_overhead = fixed_type_block_overhead (s, sizeof (struct type##_block)); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3915 DO_NOTHING
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3916
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3917 #define COPY_INTO_LRECORD_STATS(type) \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3918 do { \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3919 COUNT_FROB_BLOCK_USAGE (type); \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3920 lrecord_stats[lrecord_type_##type].bytes_in_use += s; \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3921 lrecord_stats[lrecord_type_##type].bytes_in_use_overhead += \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3922 s_overhead; \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3923 lrecord_stats[lrecord_type_##type].instances_on_free_list += \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3924 gc_count_num_##type##_freelist; \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3925 lrecord_stats[lrecord_type_##type].instances_in_use += \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3926 gc_count_num_##type##_in_use; \
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3927 } while (0)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3928
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3929
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3930 /************************************************************************/
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3931 /* Allocation statistics: format nicely */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3932 /************************************************************************/
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3933
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3934 static Lisp_Object
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3935 gc_plist_hack (const Ascbyte *name, EMACS_INT value, Lisp_Object tail)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3936 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3937 /* C doesn't have local functions (or closures, or GC, or readable syntax,
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3938 or portable numeric datatypes, or bit-vectors, or characters, or
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3939 arrays, or exceptions, or ...) */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3940 return cons3 (intern (name), make_int (value), tail);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3941 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3942
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3943 /* Pluralize a lowercase English word stored in BUF, assuming BUF has
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3944 enough space to hold the extra letters (at most 2). */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3945 static void
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3946 pluralize_word (Ascbyte *buf)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3947 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3948 Bytecount len = strlen (buf);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3949 int upper = 0;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3950 Ascbyte d, e;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3951
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3952 if (len == 0 \|\| len == 1)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3953 goto pluralize_apostrophe_s;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3954 e = buf[len - 1];
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3955 d = buf[len - 2];
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3956 upper = isupper (e);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3957 e = tolower (e);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3958 d = tolower (d);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3959 if (e == 'y')
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3960 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3961 switch (d)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3962 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3963 case 'a':
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3964 case 'e':
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3965 case 'i':
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3966 case 'o':
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3967 case 'u':
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3968 goto pluralize_s;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3969 default:
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3970 buf[len - 1] = (upper ? 'I' : 'i');
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3971 goto pluralize_es;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3972 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3973 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3974 else if (e == 's' \|\| e == 'x' \|\| (e == 'h' && (d == 's' \|\| d == 'c')))
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3975 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3976 pluralize_es:
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3977 buf[len++] = (upper ? 'E' : 'e');
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3978 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3979 pluralize_s:
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3980 buf[len++] = (upper ? 'S' : 's');
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3981 buf[len] = '\0';
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3982 return;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3983
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3984 pluralize_apostrophe_s:
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3985 buf[len++] = '\'';
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3986 goto pluralize_s;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3987 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3988
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3989 static void
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3990 pluralize_and_append (Ascbyte buf, const Ascbyte name, const Ascbyte *suffix)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3991 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3992 strcpy (buf, name);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3993 pluralize_word (buf);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3994 strcat (buf, suffix);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3995 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3996
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3997 static Lisp_Object
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3998 object_memory_usage_stats (int set_total_gc_usage)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	3999 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4000 Lisp_Object pl = Qnil;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4001 int i;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4002 EMACS_INT tgu_val = 0;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4003
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4004 #ifdef NEW_GC
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4005 for (i = 0; i < countof (lrecord_implementations_table); i++)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4006 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4007 if (lrecord_stats[i].instances_in_use != 0)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4008 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4009 Ascbyte buf[255];
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4010 const Ascbyte *name = lrecord_implementations_table[i]->name;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4011
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4012 if (lrecord_stats[i].bytes_in_use_including_overhead !=
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4013 lrecord_stats[i].bytes_in_use)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4014 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4015 sprintf (buf, "%s-storage-including-overhead", name);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4016 pl = gc_plist_hack (buf,
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4017 lrecord_stats[i]
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4018 .bytes_in_use_including_overhead,
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4019 pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4020 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4021
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4022 sprintf (buf, "%s-storage", name);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4023 pl = gc_plist_hack (buf,
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4024 lrecord_stats[i].bytes_in_use,
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4025 pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4026 tgu_val += lrecord_stats[i].bytes_in_use_including_overhead;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4027
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4028 pluralize_and_append (buf, name, "-used");
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4029 pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4030 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4031 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4032
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4033 #else /* not NEW_GC */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4034
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4035 for (i = 0; i < lrecord_type_count; i++)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4036 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4037 if (lrecord_stats[i].bytes_in_use != 0
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4038 \|\| lrecord_stats[i].bytes_freed != 0
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4039 \|\| lrecord_stats[i].instances_on_free_list != 0)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4040 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4041 Ascbyte buf[255];
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4042 const Ascbyte *name = lrecord_implementations_table[i]->name;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4043
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4044 sprintf (buf, "%s-storage-overhead", name);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4045 pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use_overhead, pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4046 tgu_val += lrecord_stats[i].bytes_in_use_overhead;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4047 sprintf (buf, "%s-storage", name);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4048 pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use, pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4049 tgu_val += lrecord_stats[i].bytes_in_use;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4050 #ifdef MEMORY_USAGE_STATS
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4051 if (lrecord_stats[i].nonlisp_bytes_in_use)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4052 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4053 sprintf (buf, "%s-non-lisp-storage", name);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4054 pl = gc_plist_hack (buf, lrecord_stats[i].nonlisp_bytes_in_use,
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4055 pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4056 tgu_val += lrecord_stats[i].nonlisp_bytes_in_use;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4057 }
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4058 if (lrecord_stats[i].lisp_ancillary_bytes_in_use)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4059 {
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4060 sprintf (buf, "%s-lisp-ancillary-storage", name);
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4061 pl = gc_plist_hack (buf, lrecord_stats[i].
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4062 lisp_ancillary_bytes_in_use,
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4063 pl);
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4064 tgu_val += lrecord_stats[i].lisp_ancillary_bytes_in_use;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4065 }
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4066 #endif /* MEMORY_USAGE_STATS */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4067 pluralize_and_append (buf, name, "-freed");
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4068 if (lrecord_stats[i].instances_freed != 0)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4069 pl = gc_plist_hack (buf, lrecord_stats[i].instances_freed, pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4070 pluralize_and_append (buf, name, "-on-free-list");
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4071 if (lrecord_stats[i].instances_on_free_list != 0)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4072 pl = gc_plist_hack (buf, lrecord_stats[i].instances_on_free_list,
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4073 pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4074 pluralize_and_append (buf, name, "-used");
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4075 pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4076 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4077 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4078
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4079 pl = gc_plist_hack ("long-string-chars-storage-overhead",
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4080 gc_count_long_string_storage_including_overhead -
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4081 (gc_count_string_total_size
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4082 - gc_count_short_string_total_size), pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4083 pl = gc_plist_hack ("long-string-chars-storage",
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4084 gc_count_string_total_size
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4085 - gc_count_short_string_total_size, pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4086 do
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4087 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4088 COUNT_FROB_BLOCK_USAGE (string_chars);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4089 tgu_val += s + s_overhead;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4090 pl = gc_plist_hack ("short-string-chars-storage-overhead", s_overhead, pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4091 pl = gc_plist_hack ("short-string-chars-storage", s, pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4092 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4093 while (0);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4094
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4095 pl = gc_plist_hack ("long-strings-total-length",
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4096 gc_count_string_total_size
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4097 - gc_count_short_string_total_size, pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4098 pl = gc_plist_hack ("short-strings-total-length",
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4099 gc_count_short_string_total_size, pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4100 pl = gc_plist_hack ("long-strings-used",
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4101 gc_count_num_string_in_use
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4102 - gc_count_num_short_string_in_use, pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4103 pl = gc_plist_hack ("short-strings-used",
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4104 gc_count_num_short_string_in_use, pl);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4105
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4106 #endif /* NEW_GC */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4107
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4108 if (set_total_gc_usage)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4109 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4110 total_gc_usage = tgu_val;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4111 total_gc_usage_set = 1;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4112 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4113
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4114 return pl;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4115 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4116
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4117 static Lisp_Object
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4118 garbage_collection_statistics (void)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4119 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4120 /* The things we do for backwards-compatibility */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4121 #ifdef NEW_GC
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4122 return
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4123 list6
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4124 (Fcons (make_int (lrecord_stats[lrecord_type_cons].instances_in_use),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4125 make_int (lrecord_stats[lrecord_type_cons]
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4126 .bytes_in_use_including_overhead)),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4127 Fcons (make_int (lrecord_stats[lrecord_type_symbol].instances_in_use),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4128 make_int (lrecord_stats[lrecord_type_symbol]
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4129 .bytes_in_use_including_overhead)),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4130 Fcons (make_int (lrecord_stats[lrecord_type_marker].instances_in_use),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4131 make_int (lrecord_stats[lrecord_type_marker]
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4132 .bytes_in_use_including_overhead)),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4133 make_int (lrecord_stats[lrecord_type_string]
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4134 .bytes_in_use_including_overhead),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4135 make_int (lrecord_stats[lrecord_type_vector]
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4136 .bytes_in_use_including_overhead),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4137 object_memory_usage_stats (1));
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4138 #else /* not NEW_GC */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4139 return
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4140 list6 (Fcons (make_int (gc_count_num_cons_in_use),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4141 make_int (gc_count_num_cons_freelist)),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4142 Fcons (make_int (gc_count_num_symbol_in_use),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4143 make_int (gc_count_num_symbol_freelist)),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4144 Fcons (make_int (gc_count_num_marker_in_use),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4145 make_int (gc_count_num_marker_freelist)),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4146 make_int (gc_count_string_total_size),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4147 make_int (lrecord_stats[lrecord_type_vector].bytes_in_use +
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4148 lrecord_stats[lrecord_type_vector].bytes_freed +
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4149 lrecord_stats[lrecord_type_vector].bytes_on_free_list),
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4150 object_memory_usage_stats (1));
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4151 #endif /* not NEW_GC */
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4152 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4153
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4154 DEFUN ("object-memory-usage-stats", Fobject_memory_usage_stats, 0, 0, 0, /*
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4155 Return statistics about memory usage of Lisp objects.
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4156 */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4157 ())
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4158 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4159 return object_memory_usage_stats (0);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4160 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4161
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4162 #endif /* ALLOC_TYPE_STATS */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4163
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4164 #ifdef MEMORY_USAGE_STATS
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4165
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4166 DEFUN ("object-memory-usage", Fobject_memory_usage, 1, 1, 0, /*
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4167 Return stats about the memory usage of OBJECT.
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4168 The values returned are in the form of an alist of usage types and byte
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4169 counts. The byte counts attempt to encompass all the memory used
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4170 by the object (separate from the memory logically associated with any
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4171 other object), including internal structures and any malloc()
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4172 overhead associated with them. In practice, the byte counts are
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4173 underestimated because certain memory usage is very hard to determine
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4174 \(e.g. the amount of memory used inside the Xt library or inside the
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4175 X server).
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4176
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4177 Multiple slices of the total memory usage may be returned, separated
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4178 by a nil. Each slice represents a particular view of the memory, a
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4179 particular way of partitioning it into groups. Within a slice, there
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4180 is no overlap between the groups of memory, and each slice collectively
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4181 represents all the memory concerned. The rightmost slice typically
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4182 represents the total memory used plus malloc and dynarr overhead.
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4183
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4184 Slices describing other Lisp objects logically associated with the
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4185 object may be included, separated from other slices by `t' and from
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4186 each other by nil if there is more than one.
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4187
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4188 #### We have to figure out how to handle the memory used by the object
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4189 itself vs. the memory used by substructures. Probably the memory_usage
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4190 method should return info only about substructures and related Lisp
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4191 objects, since the caller can always find and all info about the object
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4192 itself.
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4193 */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4194 (object))
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4195 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4196 struct generic_usage_stats gustats;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4197 struct usage_stats object_stats;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4198 int i;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4199 Lisp_Object val = Qnil;
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4200 Lisp_Object stats_list;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4201
5179 14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4202 if (!LRECORDP (object))
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4203 invalid_argument
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4204 ("No memory associated with immediate objects (int or char)", object);
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4205
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4206 stats_list = OBJECT_PROPERTY (object, memusage_stats_list);
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4207
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4208 xzero (object_stats);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4209 lisp_object_storage_size (object, &object_stats);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4210
5354 22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	4211 val = Facons (Qobject_actually_requested,
22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	4212 make_int (object_stats.was_requested), val);
22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	4213 val = Facons (Qobject_malloc_overhead,
22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	4214 make_int (object_stats.malloc_overhead), val);
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4215 assert (!object_stats.dynarr_overhead);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4216 assert (!object_stats.gap_overhead);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4217
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4218 if (!NILP (stats_list))
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4219 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4220 xzero (gustats);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4221 MAYBE_OBJECT_METH (object, memory_usage, (object, &gustats));
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4222
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4223 val = Fcons (Qt, val);
5354 22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	4224 val = Facons (Qother_memory_actually_requested,
22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	4225 make_int (gustats.u.was_requested), val);
22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	4226 val = Facons (Qother_memory_malloc_overhead,
22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	4227 make_int (gustats.u.malloc_overhead), val);
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4228 if (gustats.u.dynarr_overhead)
5354 22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	4229 val = Facons (Qother_memory_dynarr_overhead,
22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	4230 make_int (gustats.u.dynarr_overhead), val);
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4231 if (gustats.u.gap_overhead)
5354 22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	4232 val = Facons (Qother_memory_gap_overhead,
22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	4233 make_int (gustats.u.gap_overhead), val);
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4234 val = Fcons (Qnil, val);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4235
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4236 i = 0;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4237 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4238 LIST_LOOP_2 (item, stats_list)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4239 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4240 if (NILP (item) \|\| EQ (item, Qt))
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4241 val = Fcons (item, val);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4242 else
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4243 {
5354 22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	4244 val = Facons (item, make_int (gustats.othervals[i]), val);
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4245 i++;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4246 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4247 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4248 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4249 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4250
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4251 return Fnreverse (val);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4252 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4253
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4254 /* Compute total memory usage associated with an object, including
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4255
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4256 (a) Storage (including overhead) allocated to the object itself
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4257 (b) Storage (including overhead) for ancillary non-Lisp structures attached
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4258 to the object
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4259 (c) Storage (including overhead) for ancillary Lisp objects attached
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4260 to the object
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4261
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4262 Store the three types of memory into the return values provided they
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4263 aren't NULL, and return a sum of the three values. Also store the
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4264 structure of individual statistics into STATS if non-zero.
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4265
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4266 Note that the value for type (c) is the sum of all three types of
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4267 memory associated with the ancillary Lisp objects.
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4268 */
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4269
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4270 Bytecount
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4271 lisp_object_memory_usage_full (Lisp_Object object, Bytecount *storage_size,
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4272 Bytecount *extra_nonlisp_storage,
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4273 Bytecount *extra_lisp_ancillary_storage,
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4274 struct generic_usage_stats *stats)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4275 {
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4276 Bytecount total;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4277
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4278 total = lisp_object_storage_size (object, NULL);
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4279 if (storage_size)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4280 *storage_size = total;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4281
5179 14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4282 if (LRECORDP (object) && HAS_OBJECT_METH_P (object, memory_usage))
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4283 {
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4284 int i;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4285 struct generic_usage_stats gustats;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4286 Bytecount sum;
5179 14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4287 struct lrecord_implementation *imp =
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4288 XRECORD_LHEADER_IMPLEMENTATION (object);
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4289
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4290 xzero (gustats);
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4291 OBJECT_METH (object, memory_usage, (object, &gustats));
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4292
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4293 if (stats)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4294 *stats = gustats;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4295
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4296 sum = 0;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4297 for (i = 0; i < imp->num_extra_nonlisp_memusage_stats; i++)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4298 sum += gustats.othervals[i];
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4299 total += sum;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4300 if (extra_nonlisp_storage)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4301 *extra_nonlisp_storage = sum;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4302
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4303 sum = 0;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4304 for (i = 0; i < imp->num_extra_lisp_ancillary_memusage_stats; i++)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4305 sum += gustats.othervals[imp->offset_lisp_ancillary_memusage_stats +
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4306 i];
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4307 total += sum;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4308 if (extra_lisp_ancillary_storage)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4309 *extra_lisp_ancillary_storage = sum;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4310 }
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4311 else
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4312 {
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4313 if (extra_nonlisp_storage)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4314 *extra_nonlisp_storage = 0;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4315 if (extra_lisp_ancillary_storage)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4316 *extra_lisp_ancillary_storage = 0;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4317 }
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4318
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4319 return total;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4320 }
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4321
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4322
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4323 Bytecount
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4324 lisp_object_memory_usage (Lisp_Object object)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4325 {
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4326 return lisp_object_memory_usage_full (object, NULL, NULL, NULL, NULL);
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4327 }
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4328
5179 14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4329 static Bytecount
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4330 tree_memory_usage_1 (Lisp_Object arg, int vectorp, int depth)
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4331 {
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4332 Bytecount total = 0;
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4333
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4334 if (depth > 200)
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4335 return total;
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4336
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4337 if (CONSP (arg))
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4338 {
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4339 SAFE_LIST_LOOP_3 (elt, arg, tail)
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4340 {
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4341 total += lisp_object_memory_usage (tail);
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4342 if (CONSP (elt) \|\| VECTORP (elt))
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4343 total += tree_memory_usage_1 (elt, vectorp, depth + 1);
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4344 if (VECTORP (XCDR (tail))) /* hack for (a b . [c d]) */
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4345 total += tree_memory_usage_1 (XCDR (tail), vectorp, depth +1);
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4346 }
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4347 }
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4348 else if (VECTORP (arg) && vectorp)
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4349 {
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4350 int i = XVECTOR_LENGTH (arg);
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4351 int j;
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4352 total += lisp_object_memory_usage (arg);
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4353 for (j = 0; j < i; j++)
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4354 {
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4355 Lisp_Object elt = XVECTOR_DATA (arg) [j];
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4356 if (CONSP (elt) \|\| VECTORP (elt))
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4357 total += tree_memory_usage_1 (elt, vectorp, depth + 1);
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4358 }
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4359 }
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4360 return total;
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4361 }
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4362
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4363 Bytecount
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4364 tree_memory_usage (Lisp_Object arg, int vectorp)
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4365 {
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4366 return tree_memory_usage_1 (arg, vectorp, 0);
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4367 }
14fda1dbdb26 add memory usage info for specifiers Ben Wing <ben@xemacs.org> parents: 5172 diff changeset	4368
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4369 #endif /* MEMORY_USAGE_STATS */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4370
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4371 #ifdef ALLOC_TYPE_STATS
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4372
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4373 DEFUN ("total-object-memory-usage", Ftotal_object_memory_usage, 0, 0, 0, /*
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4374 Return total number of bytes used for object storage in XEmacs.
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4375 This may be helpful in debugging XEmacs's memory usage.
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4376 See also `consing-since-gc' and `object-memory-usage-stats'.
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4377 */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4378 ())
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4379 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4380 return make_int (total_gc_usage + consing_since_gc);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4381 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4382
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4383 #endif /* ALLOC_TYPE_STATS */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4384
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4385
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4386 /************************************************************************/
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4387 /* Allocation statistics: Initialization */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4388 /************************************************************************/
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4389 #ifdef MEMORY_USAGE_STATS
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4390
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4391 /* Compute the number of extra memory-usage statistics associated with an
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4392 object. We can't compute this at the time INIT_LISP_OBJECT() is called
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4393 because the value of the `memusage_stats_list' property is generally
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4394 set afterwards. So we compute the values for all types of objects
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4395 after all objects have been initialized. */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4396
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4397 static void
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4398 compute_memusage_stats_length (void)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4399 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4400 int i;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4401
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4402 for (i = 0; i < countof (lrecord_implementations_table); i++)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4403 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4404 struct lrecord_implementation *imp = lrecord_implementations_table[i];
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4405
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4406 if (!imp)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4407 continue;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4408 /* For some of the early objects, Qnil was not yet initialized at
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4409 the time of object initialization, so it came up as Qnull_pointer.
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4410 Fix that now. */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4411 if (EQ (imp->memusage_stats_list, Qnull_pointer))
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4412 imp->memusage_stats_list = Qnil;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4413 {
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4414 Elemcount len = 0;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4415 Elemcount nonlisp_len = 0;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4416 Elemcount lisp_len = 0;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4417 Elemcount lisp_offset = 0;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4418 int group_num = 0;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4419 int slice_num = 0;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4420
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4421 LIST_LOOP_2 (item, imp->memusage_stats_list)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4422 {
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4423 if (EQ (item, Qt))
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4424 {
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4425 group_num++;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4426 if (group_num == 1)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4427 lisp_offset = len;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4428 slice_num = 0;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4429 }
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4430 else if (EQ (item, Qnil))
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4431 {
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4432 slice_num++;
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4433 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4434 else
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4435 {
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4436 if (slice_num == 0)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4437 {
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4438 if (group_num == 0)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4439 nonlisp_len++;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4440 else if (group_num == 1)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4441 lisp_len++;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4442 }
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4443 len++;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4444 }
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4445 }
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4446
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4447 imp->num_extra_memusage_stats = len;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4448 imp->num_extra_nonlisp_memusage_stats = nonlisp_len;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4449 imp->num_extra_lisp_ancillary_memusage_stats = lisp_len;
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5167 diff changeset	4450 imp->offset_lisp_ancillary_memusage_stats = lisp_offset;
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4451 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4452 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4453 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4454
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	4455 #endif /* MEMORY_USAGE_STATS */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4456
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4457
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	4458 /************************************************************************/
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	4459 /* Garbage Collection -- Sweep/Compact */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	4460 /************************************************************************/
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	4461
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4462 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4463 /* Free all unmarked records */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4464 static void
3024 b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	4465 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	4466 {
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	4467 struct old_lcrecord_header *header;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4468 int num_used = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4469 /* int total_size = 0; */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4470
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4471 /* First go through and call all the finalize methods.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4472 Then go through and free the objects. There used to
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4473 be only one loop here, with the call to the finalizer
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4474 occurring directly before the xfree() below. That
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4475 is marginally faster but much less safe -- if the
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4476 finalize method for an object needs to reference any
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4477 other objects contained within it (and many do),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4478 we could easily be screwed by having already freed that
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4479 other object. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4480
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4481 for (header = *prev; header; header = header->next)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4482 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4483 struct lrecord_header *h = &(header->lheader);
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	4484
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	4485 GC_CHECK_LHEADER_INVARIANTS (h);
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	4486
5142 f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object Ben Wing <ben@xemacs.org> parents: 5127 diff changeset	4487 if (! MARKED_RECORD_HEADER_P (h) && !h->free)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4488 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4489 if (LHEADER_IMPLEMENTATION (h)->finalizer)
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5126 diff changeset	4490 LHEADER_IMPLEMENTATION (h)->finalizer (wrap_pointer_1 (h));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4491 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4492 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4493
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4494 for (header = *prev; header; )
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 struct lrecord_header *h = &(header->lheader);
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	4497 if (MARKED_RECORD_HEADER_P (h))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4498 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	4499 if (! C_READONLY_RECORD_HEADER_P (h))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4500 UNMARK_RECORD_HEADER (h);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4501 num_used++;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4502 /* total_size += n->implementation->size_in_bytes (h);*/
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	4503 /* #### May modify header->next on a C_READONLY lcrecord */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4504 prev = &(header->next);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4505 header = *prev;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4506 tick_lcrecord_stats (h, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4507 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4508 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4509 {
3024 b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben] ben parents: 3017 diff changeset	4510 struct old_lcrecord_header *next = header->next;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4511 *prev = next;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4512 tick_lcrecord_stats (h, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4513 /* used to call finalizer right here. */
4976 16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO) Ben Wing <ben@xemacs.org> parents: 4969 diff changeset	4514 xfree (header);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4515 header = next;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4516 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4517 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4518 *used = num_used;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4519 /* total = total_size; /
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4520 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4521
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4522 /* And the Lord said: Thou shalt use the `c-backslash-region' command
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4523 to make macros prettier. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4524
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4525 #ifdef ERROR_CHECK_GC
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4526
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	4527 #define SWEEP_FIXED_TYPE_BLOCK_1(typename, obj_type, lheader) \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4528 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4529 struct typename##_block *SFTB_current; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4530 int SFTB_limit; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4531 int num_free = 0, num_used = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4532 \
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	4533 for (SFTB_current = current_##typename##_block, \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4534 SFTB_limit = current_##typename##_block_index; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4535 SFTB_current; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4536 ) \
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 int SFTB_iii; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4539 \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4540 for (SFTB_iii = 0; SFTB_iii < SFTB_limit; SFTB_iii++) \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4541 { \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4542 obj_type *SFTB_victim = &(SFTB_current->block[SFTB_iii]); \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4543 \
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	4544 if (LRECORD_FREE_P (SFTB_victim)) \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4545 { \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4546 num_free++; \
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 else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader)) \
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 num_used++; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4551 } \
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	4552 else if (! MARKED_RECORD_HEADER_P (&SFTB_victim->lheader)) \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4553 { \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4554 num_free++; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4555 FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \
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 else \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4558 { \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4559 num_used++; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4560 UNMARK_##typename (SFTB_victim); \
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 SFTB_current = SFTB_current->prev; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4564 SFTB_limit = countof (current_##typename##_block->block); \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4565 } \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4566 \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4567 gc_count_num_##typename##_in_use = num_used; \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4568 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	4569 COPY_INTO_LRECORD_STATS (typename); \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4570 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4571
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4572 #else /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4573
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4574 #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	4575 do { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4576 struct typename##_block *SFTB_current; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4577 struct typename##_block **SFTB_prev; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4578 int SFTB_limit; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4579 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	4580 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4581 typename##_free_list = 0; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4582 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4583 for (SFTB_prev = &current_##typename##_block, \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4584 SFTB_current = current_##typename##_block, \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4585 SFTB_limit = current_##typename##_block_index; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4586 SFTB_current; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4587 ) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4588 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4589 int SFTB_iii; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4590 int SFTB_empty = 1; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4591 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	4592 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4593 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	4594 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4595 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	4596 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4597 if (LRECORD_FREE_P (SFTB_victim)) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4598 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4599 num_free++; \
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	4600 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	4601 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4602 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	4603 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4604 SFTB_empty = 0; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4605 num_used++; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4606 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4607 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	4608 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4609 num_free++; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4610 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	4611 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4612 else \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4613 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4614 SFTB_empty = 0; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4615 num_used++; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4616 UNMARK_##typename (SFTB_victim); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4617 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4618 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4619 if (!SFTB_empty) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4620 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4621 SFTB_prev = &(SFTB_current->prev); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4622 SFTB_current = SFTB_current->prev; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4623 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4624 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	4625 && !SFTB_current->prev) \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4626 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4627 /* 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	4628 break; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4629 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4630 else \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4631 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4632 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	4633 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	4634 current_##typename##_block_index \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4635 = countof (current_##typename##_block->block); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4636 SFTB_current = SFTB_current->prev; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4637 { \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4638 *SFTB_prev = SFTB_current; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4639 xfree (SFTB_victim_block); \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4640 /* 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	4641 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	4642 num_free -= SFTB_limit; \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4643 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4644 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4645 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	4646 } \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4647 \
c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4648 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	4649 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	4650 COPY_INTO_LRECORD_STATS (typename); \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4651 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4652
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4653 #endif /* !ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4654
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	4655 #define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type) \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	4656 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	4657
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4658 #endif /* not NEW_GC */
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4659
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4660
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4661 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4662 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4663 sweep_conses (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4664 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4665 #define UNMARK_cons(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4666 #define ADDITIONAL_FREE_cons(ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4667
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	4668 SWEEP_FIXED_TYPE_BLOCK (cons, Lisp_Cons);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4669 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4670 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4671
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4672 /* Explicitly free a cons cell. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4673 void
853 2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben] ben parents: 851 diff changeset	4674 free_cons (Lisp_Object cons)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4675 {
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4676 #ifndef NEW_GC /* to avoid compiler warning */
853 2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben] ben parents: 851 diff changeset	4677 Lisp_Cons *ptr = XCONS (cons);
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4678 #endif /* not NEW_GC */
853 2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben] ben parents: 851 diff changeset	4679
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4680 #ifdef ERROR_CHECK_GC
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4681 #ifdef NEW_GC
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4682 Lisp_Cons *ptr = XCONS (cons);
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4683 #endif /* NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4684 /* 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	4685 always be four-byte aligned. If this cons cell has already been
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4686 placed on the free list, however, its car will probably contain
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4687 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	4688 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	4689 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	4690
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4691 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	4692 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	4693 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	4694 if (POINTER_TYPE_P (XTYPE (cons_car (ptr))))
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben] ben parents: 851 diff changeset	4695 ASSERT_VALID_POINTER (XPNTR (cons_car (ptr)));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4696 #endif /* ERROR_CHECK_GC */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4697
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4698 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	4699 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4700
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4701 /* explicitly free a list. You must make sure that you have
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4702 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	4703 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	4704 are, you will lose. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4705
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4706 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4707 free_list (Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4708 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4709 Lisp_Object rest, next;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4710
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4711 for (rest = list; !NILP (rest); rest = next)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4712 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4713 next = XCDR (rest);
853 2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben] ben parents: 851 diff changeset	4714 free_cons (rest);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4715 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4716 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4717
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4718 /* explicitly free an alist. You must make sure that you have
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4719 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	4720 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	4721 are, you will lose. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4722
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4723 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4724 free_alist (Lisp_Object alist)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4725 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4726 Lisp_Object rest, next;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4727
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4728 for (rest = alist; !NILP (rest); rest = next)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4729 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4730 next = XCDR (rest);
853 2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben] ben parents: 851 diff changeset	4731 free_cons (XCAR (rest));
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben] ben parents: 851 diff changeset	4732 free_cons (rest);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4733 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4734 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4735
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4736 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4737 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4738 sweep_compiled_functions (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4739 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4740 #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	4741 #define ADDITIONAL_FREE_compiled_function(ptr) \
4976 16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO) Ben Wing <ben@xemacs.org> parents: 4969 diff changeset	4742 if (ptr->args_in_array) xfree (ptr->args)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4743
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4744 SWEEP_FIXED_TYPE_BLOCK (compiled_function, Lisp_Compiled_Function);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4745 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4746
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4747 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4748 sweep_floats (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4749 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4750 #define UNMARK_float(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4751 #define ADDITIONAL_FREE_float(ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4752
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	4753 SWEEP_FIXED_TYPE_BLOCK (float, Lisp_Float);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4754 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4755
1983 9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4756 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4757 static void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4758 sweep_bignums (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4759 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4760 #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	4761 #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	4762
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4763 SWEEP_FIXED_TYPE_BLOCK (bignum, Lisp_Bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4764 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4765 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4766
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4767 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4768 static void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4769 sweep_ratios (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4770 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4771 #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	4772 #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	4773
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4774 SWEEP_FIXED_TYPE_BLOCK (ratio, Lisp_Ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4775 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4776 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4777
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4778 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4779 static void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4780 sweep_bigfloats (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4781 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4782 #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	4783 #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	4784
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4785 SWEEP_FIXED_TYPE_BLOCK (bigfloat, Lisp_Bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4786 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4787 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	4788
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4789 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4790 sweep_symbols (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4791 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4792 #define UNMARK_symbol(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4793 #define ADDITIONAL_FREE_symbol(ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4794
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	4795 SWEEP_FIXED_TYPE_BLOCK (symbol, Lisp_Symbol);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4796 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4797
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4798 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4799 sweep_extents (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4800 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4801 #define UNMARK_extent(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4802 #define ADDITIONAL_FREE_extent(ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4803
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4804 SWEEP_FIXED_TYPE_BLOCK (extent, struct extent);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4805 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4806
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4807 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4808 sweep_events (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4809 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4810 #define UNMARK_event(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4811 #define ADDITIONAL_FREE_event(ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4812
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	4813 SWEEP_FIXED_TYPE_BLOCK (event, Lisp_Event);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4814 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4815 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4816
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4817 #ifdef EVENT_DATA_AS_OBJECTS
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4818
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4819 #ifndef NEW_GC
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4820 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4821 sweep_key_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4822 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4823 #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	4824 #define ADDITIONAL_FREE_key_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4825
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4826 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	4827 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4828 #endif /* not NEW_GC */
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4829
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4830 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4831 free_key_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4832 {
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4833 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	4834 XKEY_DATA (ptr));
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4835 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4836
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4837 #ifndef NEW_GC
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4838 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4839 sweep_button_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4840 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4841 #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	4842 #define ADDITIONAL_FREE_button_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4843
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4844 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	4845 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4846 #endif /* not NEW_GC */
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4847
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4848 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4849 free_button_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4850 {
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4851 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	4852 XBUTTON_DATA (ptr));
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4853 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4854
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4855 #ifndef NEW_GC
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4856 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4857 sweep_motion_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4858 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4859 #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	4860 #define ADDITIONAL_FREE_motion_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4861
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4862 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	4863 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4864 #endif /* not NEW_GC */
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4865
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4866 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4867 free_motion_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4868 {
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4869 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	4870 XMOTION_DATA (ptr));
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4871 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4872
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4873 #ifndef NEW_GC
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4874 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4875 sweep_process_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4876 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4877 #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	4878 #define ADDITIONAL_FREE_process_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4879
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4880 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	4881 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4882 #endif /* not NEW_GC */
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4883
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4884 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4885 free_process_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4886 {
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4887 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	4888 XPROCESS_DATA (ptr));
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4889 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4890
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4891 #ifndef NEW_GC
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4892 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4893 sweep_timeout_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4894 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4895 #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	4896 #define ADDITIONAL_FREE_timeout_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4897
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4898 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	4899 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4900 #endif /* not NEW_GC */
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4901
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4902 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4903 free_timeout_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4904 {
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4905 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	4906 XTIMEOUT_DATA (ptr));
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4907 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4908
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4909 #ifndef NEW_GC
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4910 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4911 sweep_magic_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4912 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4913 #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	4914 #define ADDITIONAL_FREE_magic_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4915
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4916 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	4917 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4918 #endif /* not NEW_GC */
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4919
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4920 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4921 free_magic_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4922 {
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4923 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	4924 XMAGIC_DATA (ptr));
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4925 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4926
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4927 #ifndef NEW_GC
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4928 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4929 sweep_magic_eval_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4930 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4931 #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	4932 #define ADDITIONAL_FREE_magic_eval_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4933
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4934 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	4935 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4936 #endif /* not NEW_GC */
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4937
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4938 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4939 free_magic_eval_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4940 {
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4941 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	4942 XMAGIC_EVAL_DATA (ptr));
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4943 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4944
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4945 #ifndef NEW_GC
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4946 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4947 sweep_eval_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4948 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4949 #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	4950 #define ADDITIONAL_FREE_eval_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4951
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4952 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	4953 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4954 #endif /* not NEW_GC */
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4955
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4956 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4957 free_eval_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4958 {
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4959 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	4960 XEVAL_DATA (ptr));
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4961 }
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	4962
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4963 #ifndef NEW_GC
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4964 static void
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4965 sweep_misc_user_data (void)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4966 {
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4967 #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	4968 #define ADDITIONAL_FREE_misc_user_data(ptr)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4969
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4970 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	4971 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4972 #endif /* not NEW_GC */
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4973
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4974 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4975 free_misc_user_data (Lisp_Object ptr)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4976 {
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	4977 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	4978 XMISC_USER_DATA (ptr));
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4979 }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4980
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	4981 #endif /* EVENT_DATA_AS_OBJECTS */
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	4982
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4983 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4984 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4985 sweep_markers (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 #define UNMARK_marker(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4988 #define ADDITIONAL_FREE_marker(ptr) \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4989 do { Lisp_Object tem; \
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	4990 tem = wrap_marker (ptr); \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4991 unchain_marker (tem); \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4992 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4993
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	4994 SWEEP_FIXED_TYPE_BLOCK (marker, Lisp_Marker);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4995 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	4996 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4997
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4998 /* Explicitly free a marker. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4999 void
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5000 free_marker (Lisp_Object ptr)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5001 {
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	5002 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	5003 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5004
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5005
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5006 #if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5007
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5008 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5009 verify_string_chars_integrity (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5010 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5011 struct string_chars_block *sb;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5012
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5013 /* Scan each existing string block sequentially, string by string. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5014 for (sb = first_string_chars_block; sb; sb = sb->next)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5015 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5016 int pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5017 /* POS is the index of the next string in the block. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5018 while (pos < sb->pos)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5019 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5020 struct string_chars *s_chars =
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5021 (struct string_chars *) &(sb->string_chars[pos]);
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	5022 Lisp_String *string;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5023 int size;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5024 int fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5025
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	5026 /* 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	5027 STRING pointer is NULL) then this is an unused chunk of
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	5028 string storage. (See below.) */
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	5029
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	5030 if (STRING_CHARS_FREE_P (s_chars))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5031 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5032 fullsize = ((struct unused_string_chars *) s_chars)->fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5033 pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5034 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5035 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5036
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5037 string = s_chars->string;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5038 /* Must be 32-bit aligned. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5039 assert ((((int) string) & 3) == 0);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5040
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	5041 size = string->size_;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5042 fullsize = STRING_FULLSIZE (size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5043
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5044 assert (!BIG_STRING_FULLSIZE_P (fullsize));
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	5045 assert (XSTRING_DATA (string) == s_chars->chars);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5046 pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5047 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5048 assert (pos == sb->pos);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5049 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5050 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5051
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5052 #endif /* defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5053
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5054 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5055 /* Compactify string chars, relocating the reference to each --
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5056 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	5057 static void
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5058 compact_string_chars (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5059 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5060 struct string_chars_block *to_sb = first_string_chars_block;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5061 int to_pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5062 struct string_chars_block *from_sb;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5063
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5064 /* Scan each existing string block sequentially, string by string. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5065 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	5066 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5067 int from_pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5068 /* FROM_POS is the index of the next string in the block. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5069 while (from_pos < from_sb->pos)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5070 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5071 struct string_chars *from_s_chars =
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5072 (struct string_chars *) &(from_sb->string_chars[from_pos]);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5073 struct string_chars *to_s_chars;
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	5074 Lisp_String *string;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5075 int size;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5076 int fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5077
454 d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	5078 /* 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	5079 STRING pointer is NULL) then this is an unused chunk of
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	5080 string storage. This happens under Mule when a string's
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	5081 size changes in such a way that its fullsize changes.
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	5082 (Strings can change size because a different-length
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	5083 character can be substituted for another character.)
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	5084 In this case, after the bogus string pointer is the
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	5085 "fullsize" of this entry, i.e. how many bytes to skip. */
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	5086
d7a9135ec789 Import from CVS: tag r21-2-42 cvs parents: 452 diff changeset	5087 if (STRING_CHARS_FREE_P (from_s_chars))
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 fullsize = ((struct unused_string_chars *) from_s_chars)->fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5090 from_pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5091 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5092 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5093
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5094 string = from_s_chars->string;
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5095 gc_checking_assert (!(LRECORD_FREE_P (string)));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5096
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	5097 size = string->size_;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5098 fullsize = STRING_FULLSIZE (size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5099
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	5100 gc_checking_assert (! BIG_STRING_FULLSIZE_P (fullsize));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5101
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5102 /* 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	5103 if (! MARKED_RECORD_HEADER_P (&(string->u.lheader)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5104 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5105 from_pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5106 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5107 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5108
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5109 /* 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	5110 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	5111 cannot advance past FROM_SB here since FROM_SB is large enough
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5112 to currently contain this string. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5113 if ((to_pos + fullsize) > countof (to_sb->string_chars))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5114 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5115 to_sb->pos = to_pos;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5116 to_sb = to_sb->next;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5117 to_pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5118 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5119
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5120 /* Compute new address of this string
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5121 and update TO_POS for the space being used. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5122 to_s_chars = (struct string_chars *) &(to_sb->string_chars[to_pos]);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5123
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5124 /* Copy the string_chars to the new place. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5125 if (from_s_chars != to_s_chars)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5126 memmove (to_s_chars, from_s_chars, fullsize);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5127
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5128 /* Relocate FROM_S_CHARS's reference */
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 814 diff changeset	5129 set_lispstringp_data (string, &(to_s_chars->chars[0]));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5130
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5131 from_pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5132 to_pos += fullsize;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5133 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5134 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5135
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5136 /* Set current to the last string chars block still used and
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5137 free any that follow. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5138 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5139 struct string_chars_block *victim;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5140
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5141 for (victim = to_sb->next; victim; )
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5142 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5143 struct string_chars_block *next = victim->next;
4976 16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO) Ben Wing <ben@xemacs.org> parents: 4969 diff changeset	5144 xfree (victim);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5145 victim = next;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5146 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5147
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5148 current_string_chars_block = to_sb;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5149 current_string_chars_block->pos = to_pos;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5150 current_string_chars_block->next = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5151 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5152 }
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5153 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5154
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5155 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5156 #if 1 /* Hack to debug missing purecopy's */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5157 static int debug_string_purity;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5158
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5159 static void
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	5160 debug_string_purity_print (Lisp_Object p)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5161 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5162 Charcount i;
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 814 diff changeset	5163 Charcount s = string_char_length (p);
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	5164 stderr_out ("\"");
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5165 for (i = 0; i < s; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5166 {
867 804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben] ben parents: 858 diff changeset	5167 Ichar ch = string_ichar (p, i);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5168 if (ch < 32 \|\| ch >= 126)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5169 stderr_out ("\\%03o", ch);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5170 else if (ch == '\\' \|\| ch == '\"')
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5171 stderr_out ("\\%c", ch);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5172 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5173 stderr_out ("%c", ch);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5174 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5175 stderr_out ("\"\n");
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5176 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5177 #endif /* 1 */
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5178 #endif /* not NEW_GC */
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5179
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5180 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5181 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5182 sweep_strings (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5183 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5184 int debug = debug_string_purity;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5185
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	5186 #define UNMARK_string(ptr) do { \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	5187 Lisp_String *p = (ptr); \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	5188 UNMARK_RECORD_HEADER (&(p->u.lheader)); \
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	5189 tick_string_stats (p, 1); \
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	5190 if (debug) \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	5191 debug_string_purity_print (wrap_string (p)); \
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	5192 } while (0)
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	5193 #define ADDITIONAL_FREE_string(ptr) do { \
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	5194 Bytecount size = ptr->size_; \
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	5195 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	5196 xfree (ptr->data_); \
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	5197 } while (0)
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 428 diff changeset	5198
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5199 SWEEP_FIXED_TYPE_BLOCK_1 (string, Lisp_String, u.lheader);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5200 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5201 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5202
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5203 #ifndef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5204 void
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5205 gc_sweep_1 (void)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5206 {
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	5207 /* 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	5208 sweeping lcrecords, frob-block lrecords and dumped objects. */
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	5209 clear_lrecord_stats ();
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 5058 diff changeset	5210
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5211 /* Free all unmarked records. Do this at the very beginning,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5212 before anything else, so that the finalize methods can safely
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5213 examine items in the objects. sweep_lcrecords_1() makes
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5214 sure to call all the finalize methods before freeing anything,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5215 to complete the safety. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5216 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5217 int ignored;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5218 sweep_lcrecords_1 (&all_lcrecords, &ignored);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5219 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5220
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5221 compact_string_chars ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5222
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5223 /* Finalize methods below (called through the ADDITIONAL_FREE_foo
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5224 macros) must be extremely careful to make sure they're not
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5225 referencing freed objects. The only two existing finalize
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5226 methods (for strings and markers) pass muster -- the string
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5227 finalizer doesn't look at anything but its own specially-
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5228 created block, and the marker finalizer only looks at live
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5229 buffers (which will never be freed) and at the markers before
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5230 and after it in the chain (which, by induction, will never be
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5231 freed because if so, they would have already removed themselves
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5232 from the chain). */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5233
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5234 /* Put all unmarked strings on free list, free'ing the string chars
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5235 of large unmarked strings */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5236 sweep_strings ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5237
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5238 /* Put all unmarked conses on free list */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5239 sweep_conses ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5240
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5241 /* Free all unmarked compiled-function objects */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5242 sweep_compiled_functions ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5243
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5244 /* Put all unmarked floats on free list */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5245 sweep_floats ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5246
1983 9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5247 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5248 /* Put all unmarked bignums on free list */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5249 sweep_bignums ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5250 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5251
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5252 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5253 /* Put all unmarked ratios on free list */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5254 sweep_ratios ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5255 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5256
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5257 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5258 /* Put all unmarked bigfloats on free list */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5259 sweep_bigfloats ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5260 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5261
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5262 /* Put all unmarked symbols on free list */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5263 sweep_symbols ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5264
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5265 /* Put all unmarked extents on free list */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5266 sweep_extents ();
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 /* Put all unmarked markers on free list.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5269 Dechain each one first from the buffer into which it points. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5270 sweep_markers ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5271
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5272 sweep_events ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5273
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5274 #ifdef EVENT_DATA_AS_OBJECTS
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5275 sweep_key_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5276 sweep_button_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5277 sweep_motion_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5278 sweep_process_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5279 sweep_timeout_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5280 sweep_magic_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5281 sweep_magic_eval_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5282 sweep_eval_data ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5283 sweep_misc_user_data ();
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5284 #endif /* EVENT_DATA_AS_OBJECTS */
5158 9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	5285
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5286 #ifdef PDUMP
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	5287 pdump_objects_unmark ();
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5288 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5289 }
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5290 #endif /* not NEW_GC */
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	5291
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5292
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	5293 /************************************************************************/
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	5294 /* "Disksave Finalization" -- Preparing for Dumping */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	5295 /************************************************************************/
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5296
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5297 static void
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5298 disksave_object_finalization_1 (void)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5299 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5300 #ifdef NEW_GC
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5301 mc_finalize_for_disksave ();
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5302 #else /* not NEW_GC */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5303 struct old_lcrecord_header *header;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5304
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5305 for (header = all_lcrecords; header; header = header->next)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5306 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5307 struct lrecord_header *objh = &header->lheader;
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5308 const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (objh);
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5309 #if 0 /* possibly useful for debugging */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5310 if (!RECORD_DUMPABLE (objh) && !objh->free)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5311 {
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5312 stderr_out ("Disksaving a non-dumpable object: ");
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5313 debug_print (wrap_pointer_1 (header));
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5314 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5315 #endif
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5316 if (imp->disksave && !objh->free)
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5317 (imp->disksave) (wrap_pointer_1 (header));
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5318 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5319 #endif /* not NEW_GC */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5320 }
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5321
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5322 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5323 disksave_object_finalization (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5324 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5325 /* It's important that certain information from the environment not get
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5326 dumped with the executable (pathnames, environment variables, etc.).
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5327 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	5328 clear some known-to-be-garbage blocks of memory, so that leftover
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5329 results of old evaluation don't look like potential problems.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5330 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	5331 to turn those strings into garbage.
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	5332 */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5333
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5334 /* Yeah, this list is pretty ad-hoc... */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5335 Vprocess_environment = Qnil;
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5336 env_initted = 0;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5337 Vexec_directory = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5338 Vdata_directory = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5339 Vsite_directory = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5340 Vdoc_directory = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5341 Vexec_path = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5342 Vload_path = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5343 /* Vdump_load_path = Qnil; */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5344 /* Release hash tables for locate_file */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5345 Flocate_file_clear_hashing (Qt);
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5346 uncache_home_directory ();
776 79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben] ben parents: 771 diff changeset	5347 zero_out_command_line_status_vars ();
872 79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben] ben parents: 867 diff changeset	5348 clear_default_devices ();
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5349
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5350 #if defined(LOADHIST) && !(defined(LOADHIST_DUMPED) \|\| \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5351 defined(LOADHIST_BUILTIN))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5352 Vload_history = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5353 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5354 Vshell_file_name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5355
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5356 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5357 gc_full ();
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5358 #else /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5359 garbage_collect_1 ();
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5360 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5361
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5362 /* Run the disksave finalization methods of all live objects. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5363 disksave_object_finalization_1 ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5364
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5365 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5366 /* Zero out the uninitialized (really, unused) part of the containers
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5367 for the live strings. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5368 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5369 struct string_chars_block *scb;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5370 for (scb = first_string_chars_block; scb; scb = scb->next)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5371 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5372 int count = sizeof (scb->string_chars) - scb->pos;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5373
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5374 assert (count >= 0 && count < STRING_CHARS_BLOCK_SIZE);
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	5375 if (count != 0)
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	5376 {
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	5377 /* from the block's fill ptr to the end */
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	5378 memset ((scb->string_chars + scb->pos), 0, count);
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	5379 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5380 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5381 }
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5382 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5383
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5384 /* There, that ought to be enough... */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5385
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5386 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5387
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5388
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5389 /************************************************************************/
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5390 /* Lisp interface onto garbage collection */
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5391 /************************************************************************/
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5392
2994 ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5393 /* Debugging aids. */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5394
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5395 DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /*
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5396 Reclaim storage for Lisp objects no longer needed.
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5397 Return info on amount of space in use:
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5398 ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5399 (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	5400 PLIST)
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5401 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	5402 more detailed information.
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5403 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	5404 `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	5405 */
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5406 ())
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5407 {
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5408 /* 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	5409 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5410 gc_full ();
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5411 #else /* not NEW_GC */
2994 ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5412 garbage_collect_1 ();
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5413 #endif /* not NEW_GC */
2994 ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5414
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5415 /* 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	5416 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	5417 total_gc_usage_set = 0;
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5418 #ifdef ALLOC_TYPE_STATS
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5419 return garbage_collection_statistics ();
e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5420 #else
2994 ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5421 return Qnil;
5167 e374ea766cc1 clean up, rearrange allocation statistics code Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	5422 #endif
2994 ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5423 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5424
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5425 DEFUN ("consing-since-gc", Fconsing_since_gc, 0, 0, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5426 Return the number of bytes consed since the last garbage collection.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5427 \"Consed\" is a misnomer in that this actually counts allocation
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5428 of all different kinds of objects, not just conses.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5429
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5430 If this value exceeds `gc-cons-threshold', a garbage collection happens.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5431 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5432 ())
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5433 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5434 return make_int (consing_since_gc);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5435 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5436
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	5437 #if 0
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	5438 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	5439 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	5440 This may be helpful in debugging XEmacs's memory usage.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5441 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	5442 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5443 ())
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5444 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5445 return make_int ((EMACS_INT) sbrk (0) / 1024);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5446 }
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	5447 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5448
2994 ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5449 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	5450 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	5451 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	5452 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	5453 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	5454 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	5455 */
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	5456 ())
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	5457 {
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	5458 return make_int (total_data_usage ());
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	5459 }
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben] ben parents: 800 diff changeset	5460
4803 5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5461 #ifdef USE_VALGRIND
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5462 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	5463 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	5464 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	5465 */
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5466 ())
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5467 {
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5468 VALGRIND_DO_LEAK_CHECK;
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5469 return Qnil;
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5470 }
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5471
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5472 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	5473 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	5474 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	5475 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	5476 */
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5477 ())
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5478 {
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5479 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	5480 return Qnil;
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5481 }
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5482 #endif /* USE_VALGRIND */
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5483
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5484
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	5485 /************************************************************************/
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	5486 /* Initialization */
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	5487 /************************************************************************/
ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5159 diff changeset	5488
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5489 /* Initialization */
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5490 static void
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5491 common_init_alloc_early (void)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5492 {
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5493 #ifndef Qzero
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5494 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	5495 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5496
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5497 #ifndef Qnull_pointer
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5498 /* 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	5499 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	5500 Qnull_pointer = wrap_pointer_1 (0);
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5501 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5502
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5503 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5504 breathing_space = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5505 all_lcrecords = 0;
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5506 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5507 ignore_malloc_warnings = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5508 #ifdef DOUG_LEA_MALLOC
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5509 mallopt (M_TRIM_THRESHOLD, 1281024); / trim threshold */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5510 mallopt (M_MMAP_THRESHOLD, 641024); / mmap threshold */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5511 #if 0 /* Moved to emacs.c */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5512 mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5513 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5514 #endif
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3063 diff changeset	5515 #ifndef NEW_GC
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	5516 init_string_chars_alloc ();
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5517 init_string_alloc ();
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5518 /* #### Is it intentional that this is called twice? --ben */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5519 init_string_chars_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5520 init_cons_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5521 init_symbol_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5522 init_compiled_function_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5523 init_float_alloc ();
1983 9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5524 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5525 init_bignum_alloc ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5526 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5527 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5528 init_ratio_alloc ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5529 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5530 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5531 init_bigfloat_alloc ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james] james parents: 1957 diff changeset	5532 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5533 init_marker_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5534 init_extent_alloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5535 init_event_alloc ();
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5536 #ifdef EVENT_DATA_AS_OBJECTS
934 c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5537 init_key_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5538 init_button_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5539 init_motion_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5540 init_process_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5541 init_timeout_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5542 init_magic_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5543 init_magic_eval_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5544 init_eval_data_alloc ();
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels] michaels parents: 887 diff changeset	5545 init_misc_user_data_alloc ();
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5546 #endif /* EVENT_DATA_AS_OBJECTS */
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5547 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5548
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5549 ignore_malloc_warnings = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5550
452 3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	5551 if (staticpros_nodump)
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	5552 Dynarr_free (staticpros_nodump);
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	5553 staticpros_nodump = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	5554 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	5555 #ifdef DEBUG_XEMACS
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5556 if (staticpro_nodump_names)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5557 Dynarr_free (staticpro_nodump_names);
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	5558 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	5559 const Ascbyte *);
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5560 Dynarr_resize (staticpro_nodump_names, 100); /* ditto */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5561 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5562
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5563 #ifdef NEW_GC
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	5564 mcpros = Dynarr_new2 (Lisp_Object_dynarr, Lisp_Object);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	5565 Dynarr_resize (mcpros, 1410); /* merely a small optimization */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	5566 dump_add_root_block_ptr (&mcpros, &mcpros_description);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	5567 #ifdef DEBUG_XEMACS
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	5568 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	5569 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	5570 dump_add_root_block_ptr (&mcpro_names,
4964 1f509f82c8c9 fix compile error Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	5571 &const_Ascbyte_ptr_dynarr_description);
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	5572 #endif
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5573 #endif /* NEW_GC */
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	5574
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5575 consing_since_gc = 0;
851 e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben] ben parents: 826 diff changeset	5576 need_to_check_c_alloca = 0;
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben] ben parents: 826 diff changeset	5577 funcall_allocation_flag = 0;
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben] ben parents: 826 diff changeset	5578 funcall_alloca_count = 0;
814 a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben] ben parents: 801 diff changeset	5579
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5580 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5581 debug_string_purity = 0;
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5582 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5583
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	5584 #ifdef ERROR_CHECK_TYPES
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5585 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	5586 666;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5587 ERROR_ME_NOT.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5588 really_unlikely_name_to_have_accidentally_in_a_non_errb_structure = 42;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5589 ERROR_ME_WARN.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5590 really_unlikely_name_to_have_accidentally_in_a_non_errb_structure =
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5591 3333632;
793 e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	5592 ERROR_ME_DEBUG_WARN.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben] ben parents: 776 diff changeset	5593 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	5594 8675309;
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	5595 #endif /* ERROR_CHECK_TYPES */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5596 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5597
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5598 #ifndef NEW_GC
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5599 static void
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5600 init_lcrecord_lists (void)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5601 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5602 int i;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5603
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5604 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	5605 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5606 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	5607 staticpro_nodump (&all_lcrecord_lists[i]);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5608 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5609 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5610 #endif /* not NEW_GC */
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5611
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5612 void
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5613 init_alloc_early (void)
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5614 {
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5615 #if defined (__cplusplus) && defined (ERROR_CHECK_GC)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5616 static struct gcpro initial_gcpro;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5617
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5618 initial_gcpro.next = 0;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5619 initial_gcpro.var = &Qnil;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5620 initial_gcpro.nvars = 1;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5621 gcprolist = &initial_gcpro;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5622 #else
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5623 gcprolist = 0;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5624 #endif /* defined (__cplusplus) && defined (ERROR_CHECK_GC) */
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5625 }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5626
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5627 static void
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5628 reinit_alloc_objects_early (void)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5629 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5630 OBJECT_HAS_METHOD (string, getprop);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5631 OBJECT_HAS_METHOD (string, putprop);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5632 OBJECT_HAS_METHOD (string, remprop);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5633 OBJECT_HAS_METHOD (string, plist);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5634 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5635
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5636 void
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5637 reinit_alloc_early (void)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5638 {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5639 common_init_alloc_early ();
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5640 #ifndef NEW_GC
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5641 init_lcrecord_lists ();
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5642 #endif /* not NEW_GC */
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5643 reinit_alloc_objects_early ();
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5644 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5645
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5646 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5647 init_alloc_once_early (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5648 {
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1154 diff changeset	5649 common_init_alloc_early ();
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5650
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	5651 {
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	5652 int i;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	5653 for (i = 0; i < countof (lrecord_implementations_table); i++)
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	5654 lrecord_implementations_table[i] = 0;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	5655 }
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	5656
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	5657 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	5658
452 3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	5659 staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	5660 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	5661 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	5662 #ifdef DEBUG_XEMACS
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	5663 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	5664 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	5665 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	5666 &const_Ascbyte_ptr_dynarr_description);
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5667 #endif
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5668
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5669 #ifdef NEW_GC
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	5670 mcpros = Dynarr_new2 (Lisp_Object_dynarr, Lisp_Object);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	5671 Dynarr_resize (mcpros, 1410); /* merely a small optimization */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	5672 dump_add_root_block_ptr (&mcpros, &mcpros_description);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	5673 #ifdef DEBUG_XEMACS
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4938 diff changeset	5674 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	5675 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	5676 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	5677 &const_Ascbyte_ptr_dynarr_description);
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2666 diff changeset	5678 #endif
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5679 #else /* not NEW_GC */
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 707 diff changeset	5680 init_lcrecord_lists ();
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3176 diff changeset	5681 #endif /* not NEW_GC */
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5682
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5683 INIT_LISP_OBJECT (cons);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5684 INIT_LISP_OBJECT (vector);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5685 INIT_LISP_OBJECT (string);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5686
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5687 #ifdef NEW_GC
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5688 INIT_LISP_OBJECT (string_indirect_data);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5689 INIT_LISP_OBJECT (string_direct_data);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5690 #endif /* NEW_GC */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5691 #ifndef NEW_GC
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5692 INIT_LISP_OBJECT (lcrecord_list);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5693 INIT_LISP_OBJECT (free);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5694 #endif /* not NEW_GC */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5695
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5696 reinit_alloc_objects_early ();
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5697 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5698
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5699 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5700 syms_of_alloc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5701 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	5702 DEFSYMBOL (Qgarbage_collecting);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5703
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5704 #ifdef MEMORY_USAGE_STATS
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5705 DEFSYMBOL (Qobject_actually_requested);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5706 DEFSYMBOL (Qobject_malloc_overhead);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5707 DEFSYMBOL (Qother_memory_actually_requested);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5708 DEFSYMBOL (Qother_memory_malloc_overhead);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5709 DEFSYMBOL (Qother_memory_dynarr_overhead);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5710 DEFSYMBOL (Qother_memory_gap_overhead);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5711 #endif /* MEMORY_USAGE_STATS */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5712
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5713 DEFSUBR (Fcons);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5714 DEFSUBR (Flist);
5354 22c4e67a2e69 Remove #'acons from cl.el, make the version in alloc.c visible to Lisp Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	5715 DEFSUBR (Facons);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5716 DEFSUBR (Fvector);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5717 DEFSUBR (Fbit_vector);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5718 DEFSUBR (Fmake_byte_code);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5719 DEFSUBR (Fmake_list);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5720 DEFSUBR (Fmake_vector);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5721 DEFSUBR (Fmake_bit_vector);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5722 DEFSUBR (Fmake_string);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5723 DEFSUBR (Fstring);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5724 DEFSUBR (Fmake_symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5725 DEFSUBR (Fmake_marker);
2994 ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5726 #ifdef ALLOC_TYPE_STATS
ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5727 DEFSUBR (Fobject_memory_usage_stats);
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5728 DEFSUBR (Ftotal_object_memory_usage);
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5729 #endif /* ALLOC_TYPE_STATS */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5730 #ifdef MEMORY_USAGE_STATS
2994 ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5731 DEFSUBR (Fobject_memory_usage);
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5732 #endif /* MEMORY_USAGE_STATS */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5733 DEFSUBR (Fgarbage_collect);
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	5734 #if 0
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5735 DEFSUBR (Fmemory_limit);
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	5736 #endif
2994 ec5f23ea6d2e [xemacs-hg @ 2005-10-14 01:21:57 by ben] ben parents: 2971 diff changeset	5737 DEFSUBR (Ftotal_memory_usage);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5738 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	5739 #ifdef USE_VALGRIND
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5740 DEFSUBR (Fvalgrind_leak_check);
5d120deb60ca Enable rudimentary support for valgrind, including functions that tell valgrind Jerry James <james@xemacs.org> parents: 4776 diff changeset	5741 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	5742 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5743 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5744
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5745 void
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5746 reinit_vars_of_alloc (void)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5747 {
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5748 #ifdef MEMORY_USAGE_STATS
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5749 compute_memusage_stats_length ();
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5750 #endif /* MEMORY_USAGE_STATS */
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5751 }
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5752
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	5753 void
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5754 vars_of_alloc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5755 {
5307 c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5756 DEFVAR_CONST_INT ("array-rank-limit", &Varray_rank_limit /*
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5757 The exclusive upper bound on the number of dimensions an array may have.
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5758
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5759 XEmacs does not support multidimensional arrays, meaning this constant is,
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5760 for the moment, 2.
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5761 */);
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5762 Varray_rank_limit = 2;
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5763
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5764 DEFVAR_CONST_INT ("array-dimension-limit", &Varray_dimension_limit /*
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5765 The exclusive upper bound of an array's dimension.
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5766 Note that XEmacs may not have enough memory available to create an array
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5767 with this dimension.
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5768 */);
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5769 Varray_dimension_limit = ARRAY_DIMENSION_LIMIT;
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5770
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5771 DEFVAR_CONST_INT ("array-total-size-limit", &Varray_total_size_limit /*
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5772 The exclusive upper bound on the number of elements an array may contain.
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5773
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5774 In Common Lisp, this is distinct from `array-dimension-limit', because
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5775 arrays can have more than one dimension. In XEmacs this is not the case,
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5776 and multi-dimensional arrays need to be implemented by the user with arrays
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5777 of arrays.
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5778
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5779 Note that XEmacs may not have enough memory available to create an array
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5780 with this dimension.
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5781 */);
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5782 Varray_total_size_limit = ARRAY_DIMENSION_LIMIT;
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5229 diff changeset	5783
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5784 #ifdef DEBUG_XEMACS
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5785 DEFVAR_INT ("debug-allocation", &debug_allocation /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5786 If non-zero, print out information to stderr about all objects allocated.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5787 See also `debug-allocation-backtrace-length'.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5788 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5789 debug_allocation = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5790
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5791 DEFVAR_INT ("debug-allocation-backtrace-length",
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5792 &debug_allocation_backtrace_length /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5793 Length (in stack frames) of short backtrace printed out by `debug-allocation'.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5794 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5795 debug_allocation_backtrace_length = 2;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5796 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5797
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5798 DEFVAR_BOOL ("purify-flag", &purify_flag /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5799 Non-nil means loading Lisp code in order to dump an executable.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5800 This means that certain objects should be allocated in readonly space.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5801 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5802 }

Mercurial > hg > xemacs-beta

annotate src/alloc.c @ 5531:1b054bc2ac40