Commits

Anonymous committed 3742ea8

Checking in final CVS version of workspace 'ben-lisp-object'

  • Participants
  • Parent commits e56f733
  • Branches ben-lisp-object
  • Tags ben-lisp-object-final-ws-year-2005

Comments (0)

Files changed (127)

File ChangeLog

File contents unchanged.

File Makefile.in.in

File contents unchanged.

File build-msw-release.sh

File contents unchanged.
   # 1. Remove the extension, and $U if already installed.
   ac_i=`echo "$ac_i" |
 	 sed 's/\$U\././;s/\.o$//;s/\.obj$//'`
-  # 2. Add them.
-  ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext"
-  ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo'
+  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR
+  #    will be set to the directory where LIBOBJS objects are built.
+  ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext"
+  ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo'
 done
 LIBOBJS=$ac_libobjs
 

File dynodump/Makefile.in.in

File contents unchanged.

File etc/editclient.sh

File contents unchanged.

File etc/photos/james.png

Old
Old image
New
New image

File etc/photos/jamesm.png

Old
Old image
New
New image

File etc/xemacs-fe.sh

File contents unchanged.

File lib-src/ChangeLog

File contents unchanged.

File lib-src/Makefile.in.in

File contents unchanged.

File lib-src/ad2c

File contents unchanged.

File lib-src/add-big-package.sh

File contents unchanged.

File lib-src/gnuattach

File contents unchanged.

File lib-src/gnudepend.pl

File contents unchanged.

File lib-src/gnudoit

File contents unchanged.

File lib-src/gzip-el.sh

File contents unchanged.

File lib-src/installexe.sh

File contents unchanged.

File lib-src/rcs-checkin

File contents unchanged.

File lib-src/rcs2log

File contents unchanged.

File lib-src/update-autoloads.sh

File contents unchanged.

File lib-src/update-custom.sh

File contents unchanged.

File lib-src/vcdiff

File contents unchanged.

File lisp/ChangeLog

+2005-11-13  Ben Wing  <ben@xemacs.org>
+
+	* disp-table.el:
+	* disp-table.el (describe-display-table):
+	* disp-table.el (make-display-table):
+	* disp-table.el (display-table-p): New.
+	* disp-table.el (frob-display-table):
+	* disp-table.el (put-display-table-range): New.
+	* disp-table.el (put-display-table): New.
+	* disp-table.el (get-display-table): New.
+	* disp-table.el (standard-display-default-1):
+	* disp-table.el (standard-display-ascii):
+	* disp-table.el (standard-display-g1):
+	* disp-table.el (standard-display-graphic):
+	* disp-table.el (standard-display-underline):
+	* disp-table.el (standard-display-european):
+	* font.el:
+	* font.el (font-caps-display-table):
+	Make display tables be char tables, not vectors of 256.  Create new
+	functions `put-display-table', `get-display-table', `put-display-table-range'
+	for accessing/modifying a display table in an abstract fashion.
+	Rewrite font.el to use them.
+
+	NOTE: This will break code that assumes it can `aset' display tables.
+
 2005-11-08  Malcolm Purvis  <malcolmp@xemacs.org>
 
 	* help.el:

File lisp/diagnose.el

File contents unchanged.

File lisp/disp-table.el

 
 ;; Copyright (C) 1987, 1994, 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Sun Microsystems.
+;; Copyright (C) 2005 Ben Wing.
 
-;; Author: Howard Gayle
 ;; Maintainer: XEmacs Development Team
 ;; Keywords: i18n, internal
 
 
 ;;; Commentary:
 
-;; #### Need lots of work.  make-display-table depends on a value
-;; that is a define in the C code.  Maybe we should just move the
-;; function into C.
-
-;; #### display-tables-as-vectors is really evil and a big pain in
-;; the ass.
+;; #### Needs work.
 
 ;; Rewritten for XEmacs July 1995, Ben Wing.
-
+;; November 1998?, display tables generalized to char/range tables, Hrvoje
+;; Niksic.
+;; February 2005, rewrite this file to handle generalized display tables,
+;; Ben Wing.
 
 ;;; Code:
 
   (with-displaying-help-buffer
    (lambda ()
      (princ "\nCharacter display glyph sequences:\n")
-     (save-excursion
-       (let ((vector (make-vector 256 nil))
-             (i 0))
-         (while (< i 256)
-           (aset vector i (aref dt i))
-           (incf i))
-	 ;; FSF calls `describe-vector' here, but it is so incredibly
-	 ;; lame a function for that name that I cannot bring myself
-	 ;; to porting it.  Here is what `describe-vector' does:
-	 (terpri)
-	 (let ((old (aref vector 0))
-	       (oldpos 0)
-	       (i 1)
-	       str)
-	   (while (<= i 256)
-	     (when (or (= i 256)
-		       (not (equal old (aref vector i))))
-	       (if (eq oldpos (1- i))
-		   (princ (format "%s\t\t%s\n"
-				  (single-key-description (int-char oldpos))
-				  old))
-		 (setq str (format "%s - %s"
-				   (single-key-description (int-char oldpos))
-				   (single-key-description (int-char (1- i)))))
-		 (princ str)
-		 (princ (make-string (max (- 2 (/ (length str)
-						  tab-width)) 1) ?\t))
-		 (princ old)
-		 (terpri))
-	       (or (= i 256)
-		   (setq old (aref vector i)
-			 oldpos i)))
-	     (incf i))))))))
+     (flet ((describe-display-table-entry
+	      (entry stream)
+	      ;; #### Write better version
+	      (princ entry stream))
+	    (describe-display-table-range
+	      (first last entry)
+	      (if (eq first last)
+		  (princ (format "%s\t\t"
+				 (single-key-description (int-char first))))
+		(let ((str (format "%s - %s"
+				   (single-key-description (int-char first))
+				   (single-key-description (int-char last)))))
+		  (princ str)
+		  (princ (make-string (max (- 2 (/ (length str)
+						   tab-width)) 1) ?\t))))
+	      (describe-display-table-entry entry standard-output)
+	      (terpri)))
+       (cond ((vectorp dt)
+	      (save-excursion
+	       (let ((vector (make-vector 256 nil))
+		     (i 0))
+		 (while (< i 256)
+		   (aset vector i (aref dt i))
+		   (incf i))
+		 ;; FSF calls `describe-vector' here, but it is so incredibly
+		 ;; lame a function for that name that I cannot bring myself
+		 ;; to port it.  Here is what `describe-vector' does:
+		 (terpri)
+		 (let ((old (aref vector 0))
+		       (oldpos 0)
+		       (i 1))
+		   (while (<= i 256)
+		     (when (or (= i 256)
+			       (not (equal old (aref vector i))))
+		       (describe-display-table-range oldpos (1- i) old)
+		       (or (= i 256)
+			   (setq old (aref vector i)
+				 oldpos i)))
+		     (incf i))))))
+	     ((char-table-p dt)
+	      (describe-char-table dt 'map-char-table
+	       'describe-display-table-entry
+	       standard-output))
+	     ((range-table-p dt)
+	      (map-range-table
+	       #'(lambda (beg end value)
+		   (describe-display-table-range beg end value))
+	       dt)))))))
 
 ;;;###autoload
 (defun describe-current-display-table (&optional domain)
 
 ;;;###autoload
 (defun make-display-table ()
-  "Return a new, empty display table."
-  (make-vector 256 nil))
+  "Return a new, empty display table.
+Modify a display table using `put-display-table'.  Look up in display tables
+using `get-display-table'.  The exact format of display tables and their
+specs is described in `current-display-table'."
+  ;; #### This should do something smarter.
+  ;; #### Should use range table but there are bugs in range table and
+  ;; perhaps in callers not expecting this.
+  ;(make-range-table 'start-closed-end-closed)
+  ;(make-vector 256 nil)
+  ;; #### Should be type `display-table'
+  (make-char-table 'generic))
+
+(defun display-table-p (object)
+  "Return t if OBJECT is a display table.
+See `make-display-table'."
+  (or (and (vectorp object) (= (length object) 256))
+      (and (char-table-p object) (memq (char-table-type object)
+				       '(char generic display)))
+      (range-table-p object)))
 
 ;; #### we need a generic frob-specifier function.
 ;; #### this also needs to be redone like frob-face-property.
 
 ;; Let me say one more time how much dynamic scoping sucks.
 
-(defun frob-display-table (fdt-function fdt-locale)
+;; #### Need more thinking about basic primitives for modifying a specifier.
+;; cf `modify-specifier-instances'.
+
+(defun frob-display-table (fdt-function fdt-locale &optional tag-set)
   (or fdt-locale (setq fdt-locale 'global))
-  (or (specifier-spec-list current-display-table fdt-locale)
+  (or (specifier-spec-list current-display-table fdt-locale tag-set)
       (add-spec-to-specifier current-display-table (make-display-table)
-			     fdt-locale))
+			     fdt-locale tag-set))
   (add-spec-list-to-specifier
    current-display-table
    (list (cons fdt-locale
                   (funcall fdt-function (cdr fdt-x))
                   fdt-x)
 		(cdar (specifier-spec-list current-display-table
-					   fdt-locale)))))))
+					   fdt-locale tag-set)))))))
+
+(defun put-display-table-range (l h spec display-table)
+  "Display characters in range L .. H, inclusive, in DISPLAY-TABLE using SPEC.
+Display tables are described in `current-display-table'."
+  (check-argument-type 'display-table-p display-table)
+  (cond ((vectorp display-table)
+	 (while (<= l h)
+	   (aset display-table l spec)
+	   (setq l (1+ l))))
+	((char-table-p display-table)
+	 (while (<= l h)
+	   (put-char-table l spec display-table)
+	   (setq l (1+ l))))
+	((range-table-p display-table)
+	 (put-range-table l h spec display-table))))
+
+(defun put-display-table (ch spec display-table)
+  "Display character spec CH in DISPLAY-TABLE using SPEC.
+CH can be a character, a charset, or t for all characters.
+Display tables are described in `current-display-table'."
+  (cond ((eq ch t)
+	 (cond ((vectorp display-table)
+		(put-display-table-range 0 (1- (length display-table)) spec
+					 display-table))
+	       ((range-table-p display-table)
+		; major hack
+		(put-display-table-range 0 (string-to-int "3FFFFFFF" 16)
+					 spec display-table))
+	       ((char-table-p display-table)
+		(put-char-table t spec display-table))))
+	((charsetp ch)
+	 (cond ((vectorp display-table)
+		;; #### fix
+		nil)
+	       ((range-table-p display-table)
+		;; #### fix
+		nil)
+	       ((char-table-p display-table)
+		(put-char-table ch spec display-table))))
+	(t (put-display-table-range ch ch spec display-table))))
+
+(defun get-display-table (char display-table)
+  "Return SPEC of CHAR in DISPLAY-TABLE.
+See `current-display-table'."
+  (check-argument-type 'display-table-p display-table)
+  (cond ((vectorp display-table)
+	 (aref display-table char))
+	((char-table-p display-table)
+	 (get-char-table char display-table))
+	((range-table-p display-table)
+	 (get-range-table char display-table))))
 
 (defun standard-display-8bit-1 (dt l h)
   (while (<= l h)
-    (aset dt l (char-to-string l))
+    (put-display-table l (char-to-string l) dt)
     (setq l (1+ l))))
 
 ;;;###autoload
 
 (defun standard-display-default-1 (dt l h)
   (while (<= l h)
-    (aset dt l nil)
+    (put-display-table l nil dt)
     (setq l (1+ l))))
 
 ;;;###autoload
   "Display character C using printable string S."
   (frob-display-table
    (lambda (x)
-     (aset x c s))
+     (put-display-table c s x))
    locale))
 
-
-;;; #### should frob in a 'tty locale.
-
 ;;;###autoload
 (defun standard-display-g1 (c sc &optional locale)
   "Display character C as character SC in the g1 character set.
-This function assumes that your terminal uses the SO/SI characters;
-it is meaningless for an X frame."
+This only has an effect on TTY devices and assumes that your terminal uses
+the SO/SI characters."
   (frob-display-table
    (lambda (x)
-     (aset x c (concat "\016" (char-to-string sc) "\017")))
-   locale))
-
-
-;;; #### should frob in a 'tty locale.
+     (put-display-table c (concat "\016" (char-to-string sc) "\017") x))
+   locale
+   'tty))
 
 ;;;###autoload
 (defun standard-display-graphic (c gc &optional locale)
   "Display character C as character GC in graphics character set.
-This function assumes VT100-compatible escapes; it is meaningless for an
-X frame."
+This only has an effect on TTY devices and assumes VT100-compatible escapes."
   (frob-display-table
    (lambda (x)
-     (aset x c (concat "\e(0" (char-to-string gc) "\e(B")))
-   locale))
+     (put-display-table c (concat "\e(0" (char-to-string gc) "\e(B") x))
+   locale
+   'tty))
 
-;;; #### should frob in a 'tty locale.
 ;;; #### the FSF equivalent of this makes this character be displayed
 ;;; in the 'underline face.  There's no current way to do this with
 ;;; XEmacs display tables.
   "Display character C as character UC plus underlining."
   (frob-display-table
    (lambda (x)
-     (aset x c (concat "\e[4m" (char-to-string uc) "\e[m")))
-   locale))
+     (put-display-table c (concat "\e[4m" (char-to-string uc) "\e[m") x))
+   locale
+   'tty))
 
 ;;;###autoload
 (defun standard-display-european (arg &optional locale)
    (lambda (x)
      (if (or (<= (prefix-numeric-value arg) 0)
              (and (null arg)
-                  (equal (aref x 160) (char-to-string 160))))
+                  (equal (get-display-table 160 x) (char-to-string 160))))
          (standard-display-default-1 x 160 255)
        (standard-display-8bit-1 x 160 255)))
    locale))

File lisp/files.el

File contents unchanged.

File lisp/font.el

 
 ;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
 ;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
-;; Copyright (C) 2002, 2004 Ben Wing.
+;; Copyright (C) 2002, 2004, 2005 Ben Wing.
 
 ;; Author: wmperry
 ;; Maintainer: XEmacs Development Team
 	(i 0))
     ;; Standard ASCII characters
     (while (< i 26)
-      (aset table (+ i ?a) (+ i ?A))
+      (put-display-table (+ i ?a) (+ i ?A) table)
       (setq i (1+ i)))
     ;; Now ISO translations
     (setq i 224)
     (while (< i 247)			;; Agrave - Ouml
-      (aset table i (- i 32))
+      (put-display-table i (- i 32) table)
       (setq i (1+ i)))
     (setq i 248)
     (while (< i 255)			;; Oslash - Thorn
-      (aset table i (- i 32))
+      (put-display-table i (- i 32) table)
       (setq i (1+ i)))
     table))
 

File lwlib/ChangeLog

File contents unchanged.

File lwlib/Makefile.in.in

File contents unchanged.

File lwlib/lwlib-internal.h

File contents unchanged.

File lwlib/lwlib.c

File contents unchanged.

File lwlib/xlwtabs.c

File contents unchanged.

File man/Makefile

File contents unchanged.

File modules/ChangeLog

File contents unchanged.

File modules/common/Makefile.common

File contents unchanged.

File modules/ldap/configure

File contents unchanged.

File modules/ldap/eldap.c

 /* LDAP client interface for XEmacs.
    Copyright (C) 1998 Free Software Foundation, Inc.
-   Copyright (C) 2004 Ben Wing.
+   Copyright (C) 2004, 2005 Ben Wing.
    
 
 This file is part of XEmacs.
   ldap->ld = NULL;
 }
 
+#f 0
 DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap, 0,
                                mark_ldap, print_ldap, finalize_ldap,
                                NULL, NULL, ldap_description, Lisp_LDAP);
-
+#else
+DEFINE_NONDUMPABLE_LRECORD_IMPLEMENTATION ("ldap", ldap, mark_ldap,
+					   print_ldap, finalize_ldap,
+					   NULL, NULL, ldap_description,
+					   Lisp_LDAP);
+#endif
 
 /************************************************************************/
 /*                        Basic ldap accessors                          */
   int rc;
   int i, j;
   Elemcount len;
-
   Lisp_Object values  = Qnil;
   struct gcpro gcpro1;
 
   int i, j, rc;
   Lisp_Object mod_op;
   Elemcount len;
-
   Lisp_Object values  = Qnil;
   struct gcpro gcpro1;
 

File modules/ldap/install-sh

File contents unchanged.

File modules/postgresql/configure

File contents unchanged.

File modules/postgresql/install-sh

File contents unchanged.

File modules/postgresql/postgresql.c

 
 #ifdef RUNNING_XEMACS_21_1
 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn,
-			       mark_pgconn, print_pgconn, finalize_pgconn,
+			       2mark_pgconn, print_pgconn, finalize_pgconn,
 			       NULL, NULL,
 			       Lisp_PGconn);
-#else
+#elif defined (RUNNING_XEMACS_21_4)
 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn,
 			       0, /*dumpable-flag*/
 			       mark_pgconn, print_pgconn, finalize_pgconn,
 			       NULL, NULL,
 			       pgconn_description,
 			       Lisp_PGconn);
+#else
+DEFINE_NONDUMPABLE_LRECORD_IMPLEMENTATION ("pgconn", pgconn,
+					   mark_pgconn, print_pgconn,
+					   finalize_pgconn,
+					   NULL, NULL,
+					   pgconn_description,
+					   Lisp_PGconn);
 #endif
 /****/
 

File modules/sample/external/install-sh

File contents unchanged.

File modules/sample/internal/install-sh

File contents unchanged.

File move-if-change

File contents unchanged.

File netinstall/ChangeLog

File contents unchanged.

File netinstall/Makefile.in.in

File contents unchanged.

File nt/README

File contents unchanged.

File src/ChangeLog

+2005-11-22  Ben Wing  <ben@xemacs.org>
+
+	* alloc.c:
+	* alloc.c (assert_proper_sizing):
+	* alloc.c (alloc_sized_lrecord_1):
+	* alloc.c (alloc_sized_lrecord):
+	* alloc.c (noseeum_alloc_sized_lrecord):
+	* alloc.c (alloc_lrecord):
+	* alloc.c (old_alloc_sized_lcrecord):
+	* alloc.c (make_vector_internal):
+	* alloc.c (make_bit_vector_internal):
+	* alloc.c (alloc_automanaged_sized_lcrecord):
+	* buffer.c (allocate_buffer):
+	* buffer.c (DEFVAR_BUFFER_LOCAL_1):
+	* buffer.c (common_init_complex_vars_of_buffer):
+	* casetab.c (allocate_case_table):
+	* chartab.c (Fmake_char_table):
+	* chartab.c (make_char_table_entry):
+	* chartab.c (copy_char_table_entry):
+	* chartab.c (Fcopy_char_table):
+	* console.c (allocate_console):
+	* console.c (DEFVAR_CONSOLE_LOCAL_1):
+	* console.c (common_init_complex_vars_of_console):
+	* data.c (make_weak_list):
+	* data.c (make_weak_box):
+	* data.c (make_ephemeron):
+	* database.c (allocate_database):
+	* device-msw.c (allocate_devmode):
+	* device.c (allocate_device):
+	* dialog-msw.c (handle_question_dialog_box):
+	* elhash.c (make_general_lisp_hash_table):
+	* elhash.c (Fcopy_hash_table):
+	* emacs.c (main_1):
+	* event-stream.c:
+	* event-stream.c (allocate_command_builder):
+	* event-stream.c (free_command_builder):
+	* event-stream.c (mark_timeout):
+	* event-stream.c (event_stream_generate_wakeup):
+	* event-stream.c (event_stream_resignal_wakeup):
+	* event-stream.c (event_stream_disable_wakeup):
+	* event-stream.c (reinit_vars_of_event_stream):
+	* extents.c (allocate_extent_auxiliary):
+	* extents.c (allocate_extent_info):
+	* extents.c (copy_extent):
+	* faces.c (allocate_face):
+	* file-coding.c (allocate_coding_system):
+	* frame.c (allocate_frame_core):
+	* glyphs.c (allocate_image_instance):
+	* glyphs.c (allocate_glyph):
+	* gui.c (allocate_gui_item):
+	* keymap.c (make_keymap):
+	* lrecord.h:
+	* lrecord.h (ALLOC_LCRECORD):
+	* lrecord.h (ALLOC_SIZED_LCRECORD):
+	* lrecord.h (struct old_lcrecord_header):
+	* lrecord.h (old_alloc_lcrecord_type):
+	* lrecord.h (alloc_lrecord_type):
+	* lrecord.h (noseeum_alloc_lrecord_type):
+	* lstream.c (Lstream_new):
+	* mule-charset.c (make_charset):
+	* objects.c (Fmake_color_instance):
+	* objects.c (Fmake_font_instance):
+	* objects.c (reinit_vars_of_objects):
+	* opaque.c (make_opaque):
+	* opaque.c (make_opaque_ptr):
+	* process.c (make_process_internal):
+	* rangetab.c (Fmake_range_table):
+	* rangetab.c (Fcopy_range_table):
+	* scrollbar.c (create_scrollbar_instance):
+	* specifier.c (make_specifier_internal):
+	* symbols.c (Fdefvaralias):
+	* toolbar.c (update_toolbar_button):
+	* tooltalk.c (make_tooltalk_message):
+	* tooltalk.c (make_tooltalk_pattern):
+	* ui-gtk.c (allocate_ffi_data):
+	* ui-gtk.c (allocate_emacs_gtk_object_data):
+	* ui-gtk.c (allocate_emacs_gtk_boxed_data):
+	* window.c (allocate_window):
+	* window.c (new_window_mirror):
+	* window.c (make_dummy_parent):
+	Create a simpler interface (ALLOC_LCRECORD) for allocating 
+
 2005-11-22  Ben Wing  <ben@xemacs.org>
 
 	* mule-coding.c (FROB):

File src/EmacsFrame.c

File contents unchanged.

File src/ExternalClient.c

File contents unchanged.

File src/ExternalShell.c

File contents unchanged.

File src/Makefile.in.in

File contents unchanged.
 }
 #endif /* not (MC_ALLOC && ALLOC_TYPE_STATS) */
 
+#define assert_proper_sizing(size)			\
+  type_checking_assert					\
+    (implementation->static_size == 0 ?			\
+     implementation->size_in_bytes_method != NULL :	\
+     implementation->size_in_bytes_method == NULL &&	\
+     implementation->static_size == size)
+
 #ifndef MC_ALLOC
 /* lcrecords are chained together through their "next" field.
    After doing the mark phase, GC will walk this linked list
 #endif /* not MC_ALLOC */
 
 #ifdef MC_ALLOC
+
 /* The basic lrecord allocation functions. See lrecord.h for details. */
-void *
-alloc_lrecord (Bytecount size,
-	       const struct lrecord_implementation *implementation)
+static Lisp_Object
+alloc_sized_lrecord_1 (Bytecount size,
+		       const struct lrecord_implementation *implementation,
+		       int noseeum)
 {
   struct lrecord_header *lheader;
 
-  type_checking_assert
-    ((implementation->static_size == 0 ?
-      implementation->size_in_bytes_method != NULL :
-      implementation->static_size == size));
+  assert_proper_sizing (size);
 
   lheader = (struct lrecord_header *) mc_alloc (size);
   gc_checking_assert (LRECORD_FREE_P (lheader));
 #ifdef ALLOC_TYPE_STATS
   inc_lrecord_stats (size, lheader);
 #endif /* ALLOC_TYPE_STATS */
-  INCREMENT_CONS_COUNTER (size, implementation->name);
-  return lheader;
-}
-
-void *
-noseeum_alloc_lrecord (Bytecount size,
-		       const struct lrecord_implementation *implementation)
-{
-  struct lrecord_header *lheader;
-
-  type_checking_assert
-    ((implementation->static_size == 0 ?
-      implementation->size_in_bytes_method != NULL :
-      implementation->static_size == size));
-
-  lheader = (struct lrecord_header *) mc_alloc (size);
-  gc_checking_assert (LRECORD_FREE_P (lheader));
-  set_lheader_implementation (lheader, implementation);
-#ifdef ALLOC_TYPE_STATS
-  inc_lrecord_stats (size, lheader);
-#endif /* ALLOC_TYPE_STATS */
-  NOSEEUM_INCREMENT_CONS_COUNTER (size, implementation->name);
-  return lheader;
+  if (noseeum)
+    NOSEEUM_INCREMENT_CONS_COUNTER (size, implementation->name);
+  else
+    INCREMENT_CONS_COUNTER (size, implementation->name);
+  return wrap_pointer_1 (lheader);
+}
+
+Lisp_Object
+alloc_sized_lrecord (Bytecount size,
+		     const struct lrecord_implementation *implementation)
+{
+  return alloc_sized_lrecord_1 (size, implementation, 0);
+}
+
+Lisp_Object
+noseeum_alloc_sized_lrecord (Bytecount size,
+			     const struct lrecord_implementation *
+			     implementation)
+{
+  return alloc_sized_lrecord_1 (size, implementation, 1);
+}
+
+Lisp_Object
+alloc_lrecord (const struct lrecord_implementation *implementation)
+{
+  type_checking_assert (implementation->static_size > 0);
+  return alloc_sized_lrecord (implementation->static_size, implementation);
 }
 
 void
    directly.  Allocates an lrecord not managed by any lcrecord-list, of a
    specified size.  See lrecord.h. */
 
-void *
-old_basic_alloc_lcrecord (Bytecount size,
+Lisp_Object
+old_alloc_sized_lcrecord (Bytecount size,
 			  const struct lrecord_implementation *implementation)
 {
   struct old_lcrecord_header *lcheader;
 
+  assert_proper_sizing (size);
   type_checking_assert
-    ((implementation->static_size == 0 ?
-      implementation->size_in_bytes_method != NULL :
-      implementation->static_size == size)
+    (!implementation->basic_p
      &&
-     (! implementation->basic_p)
-     &&
-     (! (implementation->hash == NULL && implementation->equal != NULL)));
+     !(implementation->hash == NULL && implementation->equal != NULL));
 
   lcheader = (struct old_lcrecord_header *) allocate_lisp_storage (size);
   set_lheader_implementation (&lcheader->lheader, implementation);
   lcheader->free = 0;
   all_lcrecords = lcheader;
   INCREMENT_CONS_COUNTER (size, implementation->name);
-  return lcheader;
+  return wrap_pointer_1 (lcheader);
+}
+
+Lisp_Object
+old_alloc_lcrecord (const struct lrecord_implementation *implementation)
+{
+  type_checking_assert (implementation->static_size > 0);
+  return old_alloc_sized_lcrecord (implementation->static_size,
+				   implementation);
 }
 
 #if 0 /* Presently unused */
   { XD_END }
 };
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("cons", cons,
-				     1, /*dumpable-flag*/
-				     mark_cons, print_cons, 0,
-				     cons_equal,
-				     /*
-				      * No `hash' method needed.
-				      * internal_hash knows how to
-				      * handle conses.
-				      */
-				     0,
-				     cons_description,
-				     Lisp_Cons);
+DEFINE_FROB_BLOCK_LISP_OBJECT ("cons", cons, Lisp_Cons, cons_description,
+			       1, /*dumpable-flag*/
+			       mark_cons, print_cons, cons_equal,
+			       /*
+				* No `hash' method needed.
+				* internal_hash knows how to
+				* handle conses.
+				*/
+			       0, 0);
 
 DEFUN ("cons", Fcons, 2, 2, 0, /*
 Create a new cons, give it CAR and CDR as components, and return it.
   { XD_END }
 };
 
-DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("vector", vector,
+DEFINE_SIZABLE_LISP_OBJECT ("vector", vector,
 					1, /*dumpable-flag*/
 					mark_vector, print_vector, 0,
 					vector_equal,
   /* no `next' field; we use lcrecords */
   Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object,
 						  contents, sizei);
-  Lisp_Vector *p =
-    (Lisp_Vector *) BASIC_ALLOC_LCRECORD (sizem, &lrecord_vector);
+  Lisp_Object obj = ALLOC_SIZED_LISP_OBJECT (sizem, vector);
+  Lisp_Vector *p = XVECTOR (obj);
 
   p->size = sizei;
   return p;
   Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector,
 						  unsigned long,
 						  bits, num_longs);
-  Lisp_Bit_Vector *p = (Lisp_Bit_Vector *)
-    BASIC_ALLOC_LCRECORD (sizem, &lrecord_bit_vector);
+  Lisp_Object obj = ALLOC_SIZED_LISP_OBJECT (sizem, bit_vector);
+  Lisp_Bit_Vector *p = XBIT_VECTOR (obj);
 
   bit_vector_length (p) = sizei;
   return p;
    standard way to do finalization when using
    SWEEP_FIXED_TYPE_BLOCK(). */
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string,
-						1, /*dumpable-flag*/
+DEFINE_BASIC_LISP_OBJECT_WITH_PROPS ("string", string,
 						mark_string, print_string,
 						0, string_equal, 0,
 						string_description,
     }
 }
 
-DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string,
-					  1, /*dumpable-flag*/
+DEFINE_LISP_OBJECT_WITH_PROPS ("string", string,
 					  mark_string, print_string,
 					  finalize_string,
 					  string_equal, 0,
 /************************************************************************/
 
 /* Lcrecord lists are used to manage the allocation of particular
-   sorts of lcrecords, to avoid calling BASIC_ALLOC_LCRECORD() (and thus
+   sorts of lcrecords, to avoid calling ALLOC_LISP_OBJECT() (and thus
    malloc() and garbage-collection junk) as much as possible.
    It is similar to the Blocktype class.
 
   { XD_END }
 };
 
-DEFINE_LRECORD_IMPLEMENTATION ("free", free,
-			       0, /*dumpable-flag*/
-			       0, internal_object_printer,
-			       0, 0, 0, free_description,
-			       struct free_lcrecord_header);
+DEFINE_NONDUMPABLE_LISP_OBJECT ("free", free, 0, 0,
+					   0, 0, 0, free_description,
+					   struct free_lcrecord_header);
 
 const struct memory_description lcrecord_list_description[] = {
   { XD_LISP_OBJECT, offsetof (struct lcrecord_list, free), 0, { 0 },
   return Qnil;
 }
 
-DEFINE_LRECORD_IMPLEMENTATION ("lcrecord-list", lcrecord_list,
-			       0, /*dumpable-flag*/
-			       mark_lcrecord_list, internal_object_printer,
-			       0, 0, 0, lcrecord_list_description,
-			       struct lcrecord_list);
+DEFINE_NONDUMPABLE_LISP_OBJECT ("lcrecord-list", lcrecord_list,
+					   mark_lcrecord_list,
+					   0,
+					   0, 0, 0, lcrecord_list_description,
+					   struct lcrecord_list);
 
 Lisp_Object
 make_lcrecord_list (Elemcount size,
 
 static Lisp_Object all_lcrecord_lists[countof (lrecord_implementations_table)];
 
-void *
-alloc_automanaged_lcrecord (Bytecount size,
-			    const struct lrecord_implementation *imp)
+Lisp_Object
+alloc_automanaged_sized_lcrecord (Bytecount size,
+				  const struct lrecord_implementation *imp)
 {
   if (EQ (all_lcrecord_lists[imp->lrecord_type_index], Qzero))
     all_lcrecord_lists[imp->lrecord_type_index] =
       make_lcrecord_list (size, imp);
 
-  return XPNTR (alloc_managed_lcrecord
-		(all_lcrecord_lists[imp->lrecord_type_index]));
+  return alloc_managed_lcrecord (all_lcrecord_lists[imp->lrecord_type_index]);
+}
+
+Lisp_Object
+alloc_automanaged_lcrecord (const struct lrecord_implementation *imp)
+{
+  type_checking_assert (imp->static_size > 0);
+  return alloc_automanaged_sized_lcrecord (imp->static_size, imp);
 }
 
 void
       lrecord_implementations_table[i] = 0;
   }
 
-  INIT_LRECORD_IMPLEMENTATION (cons);
-  INIT_LRECORD_IMPLEMENTATION (vector);
-  INIT_LRECORD_IMPLEMENTATION (string);
+  INIT_LISP_OBJECT (cons);
+  INIT_LISP_OBJECT (vector);
+  INIT_LISP_OBJECT (string);
 #ifndef MC_ALLOC
-  INIT_LRECORD_IMPLEMENTATION (lcrecord_list);
-  INIT_LRECORD_IMPLEMENTATION (free);
+  INIT_LISP_OBJECT (lcrecord_list);
+  INIT_LISP_OBJECT (free);
 #endif /* not MC_ALLOC */
 
   staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);

File src/alloca.c

File contents unchanged.

File src/buffer.c

 /* We do not need a finalize method to handle a buffer's children list
    because all buffers have `kill-buffer' applied to them before
    they disappear, and the children removal happens then. */
-DEFINE_LRECORD_IMPLEMENTATION ("buffer", buffer,
-			       0, /*dumpable-flag*/
-                               mark_buffer, print_buffer, 0, 0, 0,
-			       buffer_description,
-			       struct buffer);
+DEFINE_NONDUMPABLE_LISP_OBJECT ("buffer", buffer, mark_buffer,
+					   print_buffer, 0, 0, 0,
+					   buffer_description,
+					   struct buffer);
 
 DEFUN ("bufferp", Fbufferp, 1, 1, 0, /*
 Return t if OBJECT is an editor buffer.
 static struct buffer *
 allocate_buffer (void)
 {
-  struct buffer *b = ALLOC_LCRECORD_TYPE (struct buffer, &lrecord_buffer);
+  Lisp_Object obj = ALLOC_LISP_OBJECT (buffer);
+  struct buffer *b = XBUFFER (obj);
 
   COPY_LCRECORD (b, XBUFFER (Vbuffer_defaults));
 
 void
 syms_of_buffer (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (buffer);
+  INIT_LISP_OBJECT (buffer);
 
   DEFSYMBOL (Qbuffer_live_p);
   DEFSYMBOL (Qbuffer_or_string_p);
   struct symbol_value_forward *I_hate_C =				  \
     alloc_lrecord_type (struct symbol_value_forward,			  \
 			&lrecord_symbol_value_forward);			  \
-  /*mcpro ((Lisp_Object) I_hate_C);*/					\
+  /*mcpro ((Lisp_Object) I_hate_C);*/					  \
 									  \
   I_hate_C->magic.value = &(buffer_local_flags.field_name);		  \
   I_hate_C->magic.type = forward_type;					  \
 {
   /* Make sure all markable slots in buffer_defaults
      are initialized reasonably, so mark_buffer won't choke. */
-  struct buffer *defs = ALLOC_LCRECORD_TYPE (struct buffer, &lrecord_buffer);
-  struct buffer *syms = ALLOC_LCRECORD_TYPE (struct buffer, &lrecord_buffer);
+  Lisp_Object defobj = ALLOC_LISP_OBJECT (buffer);
+  struct buffer *defs = XBUFFER (defobj);
+  Lisp_Object symobj = ALLOC_LISP_OBJECT (buffer);
+  struct buffer *syms = XBUFFER (symobj);
 
   staticpro_nodump (&Vbuffer_defaults);
   staticpro_nodump (&Vbuffer_local_symbols);
-  Vbuffer_defaults = wrap_buffer (defs);
-  Vbuffer_local_symbols = wrap_buffer (syms);
+  Vbuffer_defaults = defobj;
+  Vbuffer_local_symbols = symobj;
 
   nuke_all_buffer_slots (syms, Qnil);
   nuke_all_buffer_slots (defs, Qnil);

File src/bytecode.c

     }
 }
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function,
-				     1, /*dumpable_flag*/
+DEFINE_BASIC_LISP_OBJECT ("compiled-function", compiled_function,
 				     mark_compiled_function,
 				     print_compiled_function,
 				     finalize_compiled_function,
 				     compiled_function_description,
 				     Lisp_Compiled_Function);
 #else /* not MC_ALLOC */
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function,
-				     1, /*dumpable_flag*/
+DEFINE_BASIC_LISP_OBJECT ("compiled-function", compiled_function,
 				     mark_compiled_function,
 				     print_compiled_function, 0,
 				     compiled_function_equal,
 void
 syms_of_bytecode (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (compiled_function);
+  INIT_LISP_OBJECT (compiled_function);
 
   DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state);
   DEFSYMBOL (Qbyte_code);

File src/casetab.c

 };
 
 
-DEFINE_LRECORD_IMPLEMENTATION("case-table", case_table,
-			      1, /*dumpable-flag*/
+DEFINE_LISP_OBJECT("case-table", case_table,
 			      mark_case_table, print_case_table, 0,
 			      0, 0, case_table_description, Lisp_Case_Table);
 
 static Lisp_Object
 allocate_case_table (int init_tables)
 {
-  Lisp_Case_Table *ct =
-    ALLOC_LCRECORD_TYPE (Lisp_Case_Table, &lrecord_case_table);
+  Lisp_Object obj = ALLOC_LISP_OBJECT (case_table);
+  Lisp_Case_Table *ct = XCASE_TABLE (obj);
 
   if (init_tables)
     {
       SET_CASE_TABLE_CANON (ct, Qnil);
       SET_CASE_TABLE_EQV (ct, Qnil);
     }
-  return wrap_case_table (ct);
+  return obj;
 }
 
 DEFUN ("make-case-table", Fmake_case_table, 0, 0, 0, /*
 void
 syms_of_casetab (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (case_table);
+  INIT_LISP_OBJECT (case_table);
 
   DEFSYMBOL_MULTIWORD_PREDICATE (Qcase_tablep);
   DEFSYMBOL (Qdowncase);

File src/chartab.c

   { XD_END }
 };
 
-DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
-			       1, /* dumpable flag */
-                               mark_char_table_entry, internal_object_printer,
-			       0, char_table_entry_equal,
-			       char_table_entry_hash,
-			       char_table_entry_description,
-			       Lisp_Char_Table_Entry);
+DEFINE_LISP_OBJECT ("char-table-entry", char_table_entry,
+		    mark_char_table_entry, 0,
+		    0, char_table_entry_equal,
+		    char_table_entry_hash,
+		    char_table_entry_description,
+		    Lisp_Char_Table_Entry);
 
 #endif /* MULE */
 
   { XD_END }
 };
 
-DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
-			       1, /*dumpable-flag*/
-                               mark_char_table, print_char_table, 0,
+DEFINE_LISP_OBJECT ("char-table", char_table,
+			       mark_char_table, print_char_table, 0,
 			       char_table_equal, char_table_hash,
 			       char_table_description,
 			       Lisp_Char_Table);
 */
        (type))
 {
-  Lisp_Char_Table *ct;
-  Lisp_Object obj;
+  Lisp_Object obj = ALLOC_LISP_OBJECT (char_table);
+  Lisp_Char_Table *ct = XCHAR_TABLE (obj);
   enum char_table_type ty = symbol_to_char_table_type (type);
 
-  ct = ALLOC_LCRECORD_TYPE (Lisp_Char_Table, &lrecord_char_table);
   ct->type = ty;
-  obj = wrap_char_table (ct);
   if (ty == CHAR_TABLE_TYPE_SYNTAX)
     {
       /* Qgeneric not Qsyntax because a syntax table has a mirror table
 make_char_table_entry (Lisp_Object initval)
 {
   int i;
-  Lisp_Char_Table_Entry *cte =
-    ALLOC_LCRECORD_TYPE (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
+  Lisp_Object obj = ALLOC_LISP_OBJECT (char_table_entry);
+  Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
 
   for (i = 0; i < 96; i++)
     cte->level2[i] = initval;
 
-  return wrap_char_table_entry (cte);
+  return obj;
 }
 
 static Lisp_Object
 {
   Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
   int i;
-  Lisp_Char_Table_Entry *ctenew =
-    ALLOC_LCRECORD_TYPE (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
+  Lisp_Object obj = ALLOC_LISP_OBJECT (char_table_entry);
+  Lisp_Char_Table_Entry *ctenew = XCHAR_TABLE_ENTRY (obj);
 
   for (i = 0; i < 96; i++)
     {
 	ctenew->level2[i] = new_;
     }
 
-  return wrap_char_table_entry (ctenew);
+  return obj;
 }
 
 #endif /* MULE */
 
   CHECK_CHAR_TABLE (char_table);
   ct = XCHAR_TABLE (char_table);
-  ctnew = ALLOC_LCRECORD_TYPE (Lisp_Char_Table, &lrecord_char_table);
+  obj = ALLOC_LISP_OBJECT (char_table);
+  ctnew = XCHAR_TABLE (obj);
   ctnew->type = ct->type;
   ctnew->parent = ct->parent;
   ctnew->default_ = ct->default_;
   ctnew->mirror_table_p = ct->mirror_table_p;
-  obj = wrap_char_table (ctnew);
 
   for (i = 0; i < NUM_ASCII_CHARS; i++)
     {
 void
 syms_of_chartab (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (char_table);
+  INIT_LISP_OBJECT (char_table);
 
 #ifdef MULE
-  INIT_LRECORD_IMPLEMENTATION (char_table_entry);
+  INIT_LISP_OBJECT (char_table_entry);
 
   DEFSYMBOL (Qcategory_table_p);
   DEFSYMBOL (Qcategory_designator_p);

File src/config.h.in

File contents unchanged.

File src/console.c

   write_fmt_string (printcharfun, " 0x%x>", con->header.uid);
 }
 
-DEFINE_LRECORD_IMPLEMENTATION ("console", console,
-			       0, /*dumpable-flag*/
-			       mark_console, print_console, 0, 0, 0, 
-			       console_description,
-			       struct console);
+DEFINE_NONDUMPABLE_LISP_OBJECT ("console", console, mark_console,
+					   print_console, 0, 0, 0, 
+					   console_description,
+					   struct console);
 
 
 static void
 static struct console *
 allocate_console (Lisp_Object type)
 {
-  Lisp_Object console;
-  struct console *con = ALLOC_LCRECORD_TYPE (struct console, &lrecord_console);
+  Lisp_Object console = ALLOC_LISP_OBJECT (console);
+  struct console *con = XCONSOLE (console);
   struct gcpro gcpro1;
 
   COPY_LCRECORD (con, XCONSOLE (Vconsole_defaults));
 
-  console = wrap_console (con);
   GCPRO1 (console);
 
   con->conmeths = decode_console_type (type, ERROR_ME);
 void
 syms_of_console (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (console);
+  INIT_LISP_OBJECT (console);
 
   DEFSUBR (Fvalid_console_type_p);
   DEFSUBR (Fconsole_type_list);
   struct symbol_value_forward *I_hate_C =				   \
     alloc_lrecord_type (struct symbol_value_forward,			   \
 			&lrecord_symbol_value_forward);			   \
-  /*mcpro ((Lisp_Object) I_hate_C);*/					\
+  /*mcpro ((Lisp_Object) I_hate_C);*/					   \
 									   \
   I_hate_C->magic.value = &(console_local_flags.field_name);		   \
   I_hate_C->magic.type = forward_type;					   \
   /* Make sure all markable slots in console_defaults
      are initialized reasonably, so mark_console won't choke.
    */
-  struct console *defs = ALLOC_LCRECORD_TYPE (struct console, &lrecord_console);
-  struct console *syms = ALLOC_LCRECORD_TYPE (struct console, &lrecord_console);
+  Lisp_Object defobj = ALLOC_LISP_OBJECT (console);
+  struct console *defs = XCONSOLE (defobj);
+  Lisp_Object symobj = ALLOC_LISP_OBJECT (console);
+  struct console *syms = XCONSOLE (symobj);
 
   staticpro_nodump (&Vconsole_defaults);
   staticpro_nodump (&Vconsole_local_symbols);
-  Vconsole_defaults = wrap_console (defs);
-  Vconsole_local_symbols = wrap_console (syms);
+  Vconsole_defaults = defobj;
+  Vconsole_local_symbols = symobj;
 
   nuke_all_console_slots (syms, Qnil);
   nuke_all_console_slots (defs, Qnil);
 /* Primitive operations on Lisp data types for XEmacs Lisp interpreter.
    Copyright (C) 1985, 1986, 1988, 1992, 1993, 1994, 1995
    Free Software Foundation, Inc.
-   Copyright (C) 2000, 2001, 2002, 2003 Ben Wing.
+   Copyright (C) 2000, 2001, 2002, 2003, 2005 Ben Wing.
 
 This file is part of XEmacs.
 
 Lisp_Object
 make_weak_list (enum weak_list_type type)
 {
-  Lisp_Object result;
-  struct weak_list *wl =
-    ALLOC_LCRECORD_TYPE (struct weak_list, &lrecord_weak_list);
+  Lisp_Object result = ALLOC_LISP_OBJECT (weak_list);
+  struct weak_list *wl = XWEAK_LIST (result);
 
   wl->list = Qnil;
   wl->type = type;
-  result = wrap_weak_list (wl);
   wl->next_weak = Vall_weak_lists;
   Vall_weak_lists = result;
   return result;
   { XD_END }
 };
 
-DEFINE_LRECORD_IMPLEMENTATION ("weak-list", weak_list,
-			       1, /*dumpable-flag*/
+DEFINE_LISP_OBJECT ("weak-list", weak_list,
 			       mark_weak_list, print_weak_list,
 			       0, weak_list_equal, weak_list_hash,
 			       weak_list_description,
 Lisp_Object
 make_weak_box (Lisp_Object value)
 {
-  Lisp_Object result;
-
-  struct weak_box *wb =
-    ALLOC_LCRECORD_TYPE (struct weak_box, &lrecord_weak_box);
+  Lisp_Object result = ALLOC_LISP_OBJECT (weak_box);
+  struct weak_box *wb = XWEAK_BOX (result);
 
   wb->value = value;
   result = wrap_weak_box (wb);
   { XD_END}
 };
 
-DEFINE_LRECORD_IMPLEMENTATION ("weak_box", weak_box,
-			       0, /*dumpable-flag*/
-			       mark_weak_box, print_weak_box,
-			       0, weak_box_equal, weak_box_hash,
-			       weak_box_description,
-			       struct weak_box);
+DEFINE_NONDUMPABLE_LISP_OBJECT ("weak-box", weak_box, mark_weak_box,
+					   print_weak_box, 0, weak_box_equal,
+					   weak_box_hash, weak_box_description,
+					   struct weak_box);
 
 DEFUN ("make-weak-box", Fmake_weak_box, 1, 1, 0, /*
 Return a new weak box from value CONTENTS.
 }
 
 Lisp_Object
-make_ephemeron(Lisp_Object key, Lisp_Object value, Lisp_Object finalizer)
+make_ephemeron (Lisp_Object key, Lisp_Object value, Lisp_Object finalizer)
 {
-  Lisp_Object result, temp = Qnil;
+  Lisp_Object temp = Qnil;
   struct gcpro gcpro1, gcpro2;
-
-  struct ephemeron *eph =
-    ALLOC_LCRECORD_TYPE (struct ephemeron, &lrecord_ephemeron);
+  Lisp_Object result = ALLOC_LISP_OBJECT (ephemeron);
+  struct ephemeron *eph = XEPHEMERON (result);
 
   eph->key = Qnil;
   eph->cons_chain = Qnil;
   eph->value = Qnil;
 
-  result = wrap_ephemeron(eph);
+  result = wrap_ephemeron (eph);
   GCPRO2 (result, temp);
 
   eph->key = key;
-  temp = Fcons(value, finalizer);
-  eph->cons_chain = Fcons(temp, Vall_ephemerons);
+  temp = Fcons (value, finalizer);
+  eph->cons_chain = Fcons (temp, Vall_ephemerons);
   eph->value = value;
 
   Vall_ephemerons = result;
   { XD_END }
 };
 
-DEFINE_LRECORD_IMPLEMENTATION ("ephemeron", ephemeron,
-			       0, /*dumpable-flag*/
-			       mark_ephemeron, print_ephemeron,
-			       0, ephemeron_equal, ephemeron_hash,
-			       ephemeron_description,
-			       struct ephemeron);
+DEFINE_NONDUMPABLE_LISP_OBJECT ("ephemeron", ephemeron,
+					   mark_ephemeron, print_ephemeron,
+					   0, ephemeron_equal, ephemeron_hash,
+					   ephemeron_description,
+					   struct ephemeron);
 
 DEFUN ("make-ephemeron", Fmake_ephemeron, 2, 3, 0, /*
 Return a new ephemeron with key KEY, value VALUE, and finalizer FINALIZER.
 void
 syms_of_data (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (weak_list);
-  INIT_LRECORD_IMPLEMENTATION (ephemeron);
-  INIT_LRECORD_IMPLEMENTATION (weak_box);
+  INIT_LISP_OBJECT (weak_list);
+  INIT_LISP_OBJECT (ephemeron);
+  INIT_LISP_OBJECT (weak_box);
 
   DEFSYMBOL (Qquote);
   DEFSYMBOL (Qlambda);

File src/database.c

 static Lisp_Database *
 allocate_database (void)
 {
-  Lisp_Database *db = ALLOC_LCRECORD_TYPE (Lisp_Database, &lrecord_database);
+  Lisp_Object obj = ALLOC_LISP_OBJECT (database);
+  Lisp_Database *db = XDATABASE (obj);
 
   db->fname = Qnil;
   db->live_p = 0;
   db->funcs->close (db);
 }
 
-DEFINE_LRECORD_IMPLEMENTATION ("database", database,
-			       0, /*dumpable-flag*/
-                               mark_database, print_database,
-			       finalize_database, 0, 0, 
-			       database_description,
-			       Lisp_Database);
+DEFINE_NONDUMPABLE_LISP_OBJECT ("database", database,
+					   mark_database, print_database,
+					   finalize_database, 0, 0, 
+					   database_description,
+					   Lisp_Database);
 
 DEFUN ("close-database", Fclose_database, 1, 1, 0, /*
 Close database DATABASE.
 void
 syms_of_database (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (database);
+  INIT_LISP_OBJECT (database);
 
   DEFSYMBOL (Qdatabasep);
 #ifdef HAVE_DBM

File src/device-msw.c

 		internal_hash (dm->printer_name, depth + 1));
 }
 
-DEFINE_LRECORD_IMPLEMENTATION ("msprinter-settings", devmode,
-			       0, /*dumpable-flag*/
-			       mark_devmode, print_devmode, finalize_devmode,
-			       equal_devmode, hash_devmode, 
-			       devmode_description,
-			       Lisp_Devmode);
+DEFINE_NONDUMPABLE_LISP_OBJECT ("msprinter-settings", devmode,
+					   mark_devmode, print_devmode,
+					   finalize_devmode,
+					   equal_devmode, hash_devmode, 
+					   devmode_description,
+					   Lisp_Devmode);
 
 static Lisp_Object
 allocate_devmode (DEVMODEW* src_devmode, int do_copy,
 		  Lisp_Object src_name, struct device *d)
 {
-  Lisp_Devmode *dm;
-
-  dm = ALLOC_LCRECORD_TYPE (Lisp_Devmode, &lrecord_devmode);
+  Lisp_Object obj = ALLOC_LISP_OBJECT (devmode);
+  Lisp_Devmode *dm = XDEVMODE (obj);
 
   if (d)
     dm->device = wrap_device (d);
       dm->devmode = src_devmode;
     }
 
-  return wrap_devmode (dm);
+  return obj;
 }
 
 DEFUN ("msprinter-settings-copy", Fmsprinter_settings_copy, 1, 1, 0, /*
 void
 syms_of_device_mswindows (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (devmode);
+  INIT_LISP_OBJECT (devmode);
 
   DEFSUBR (Fmsprinter_get_settings);
   DEFSUBR (Fmsprinter_select_settings);

File src/device.c

   write_fmt_string (printcharfun, " 0x%x>", d->header.uid);
 }
 
-DEFINE_LRECORD_IMPLEMENTATION ("device", device,
-			       0, /*dumpable-flag*/
-			       mark_device, print_device, 0, 0, 0, 
-			       device_description,
-			       struct device);
+DEFINE_NONDUMPABLE_LISP_OBJECT ("device", device,
+					   mark_device, print_device, 0, 0, 0, 
+					   device_description,
+					   struct device);
 
 int
 valid_device_class_p (Lisp_Object class_)
 static struct device *
 allocate_device (Lisp_Object console)
 {
-  Lisp_Object device;
-  struct device *d = ALLOC_LCRECORD_TYPE (struct device, &lrecord_device);
+  Lisp_Object obj = ALLOC_LISP_OBJECT (device);
+  struct device *d = XDEVICE (obj);
   struct gcpro gcpro1;
 
-  device = wrap_device (d);
-  GCPRO1 (device);
+  GCPRO1 (obj);
 
   nuke_all_device_slots (d, Qnil);
 
 void
 syms_of_device (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (device);
+  INIT_LISP_OBJECT (device);
 
   DEFSUBR (Fvalid_device_class_p);
   DEFSUBR (Fdevice_class_list);

File src/dialog-msw.c

   return data->callbacks;
 }
 
-DEFINE_LRECORD_IMPLEMENTATION ("mswindows-dialog-id", mswindows_dialog_id,
-			       0, /* dump-able flag */
-			       mark_mswindows_dialog_id,
-			       internal_object_printer, 0, 0, 0, 
-			       mswindows_dialog_id_description,
-			       struct mswindows_dialog_id);
+DEFINE_NONDUMPABLE_INTERNAL_LISP_OBJECT ("mswindows-dialog-id",
+					 mswindows_dialog_id,
+					 struct mswindows_dialog_id,
+					 mswindows_dialog_id_description,
+					 mark_mswindows_dialog_id);
 
 /* Dialog procedure */
 static BOOL CALLBACK 
      GC-protected and thus it is put into a statically protected
      list. */
   {
-    Lisp_Object dialog_data;
     int i;
-    struct mswindows_dialog_id *did =
-      ALLOC_LCRECORD_TYPE (struct mswindows_dialog_id,
-			   &lrecord_mswindows_dialog_id);
-    
-    dialog_data = wrap_mswindows_dialog_id (did);
+    Lisp_Object obj = ALLOC_LISP_OBJECT (mswindows_dialog_id);
+    struct mswindows_dialog_id *did = XMSWINDOWS_DIALOG_ID (obj);
     
     did->frame = wrap_frame (f);
     did->callbacks = make_vector (Dynarr_length (dialog_items), Qunbound);
       qxeCreateDialogIndirectParam (NULL,
 				    (LPDLGTEMPLATE) Dynarr_atp (template_, 0),
 				    FRAME_MSWINDOWS_HANDLE (f), dialog_proc,
-				    (LPARAM) LISP_TO_VOID (dialog_data));
+				    (LPARAM) LISP_TO_VOID (obj));
     if (!did->hwnd)
       /* Something went wrong creating the dialog */
       signal_error (Qdialog_box_error, "Creating dialog", keys);
     
-    Vdialog_data_list = Fcons (dialog_data, Vdialog_data_list);
+    Vdialog_data_list = Fcons (obj, Vdialog_data_list);
     
     /* Cease protection and free dynarrays */
     unbind_to (unbind_count);
-    return dialog_data;
+    return obj;
   }
 }
 
 void
 syms_of_dialog_mswindows (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (mswindows_dialog_id);
+  INIT_LISP_OBJECT (mswindows_dialog_id);
   
   DEFKEYWORD (Q_initial_directory);
   DEFKEYWORD (Q_initial_filename);

File src/doc.c

File contents unchanged.

File src/dumper.c

File contents unchanged.

File src/elhash.c

   { XD_END }
 };
 
-DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table,
-			       1, /*dumpable-flag*/
-                               mark_hash_table, print_hash_table,
+DEFINE_LISP_OBJECT ("hash-table", hash_table,
+			       mark_hash_table, print_hash_table,
 			       finalize_hash_table,
 			       hash_table_equal, hash_table_hash,
 			       hash_table_description,
 			      double rehash_threshold,
 			      enum hash_table_weakness weakness)
 {
-  Lisp_Object hash_table;
-  Lisp_Hash_Table *ht = ALLOC_LCRECORD_TYPE (Lisp_Hash_Table, &lrecord_hash_table);
+  Lisp_Object hash_table = ALLOC_LISP_OBJECT (hash_table);
+  Lisp_Hash_Table *ht = XHASH_TABLE (hash_table);
 
   ht->test_function = test_function;
   ht->hash_function = hash_function;
   /* We leave room for one never-occupied sentinel htentry at the end.  */
   ht->hentries = xnew_array_and_zero (htentry, ht->size + 1);
 
-  hash_table = wrap_hash_table (ht);
-
   if (weakness == HASH_TABLE_NON_WEAK)
     ht->next_weak = Qunbound;
   else
        (hash_table))
 {
   const Lisp_Hash_Table *ht_old = xhash_table (hash_table);
-  Lisp_Hash_Table *ht = ALLOC_LCRECORD_TYPE (Lisp_Hash_Table, &lrecord_hash_table);
+  Lisp_Object obj = ALLOC_LISP_OBJECT (hash_table);
+  Lisp_Hash_Table *ht = XHASH_TABLE (obj);
   COPY_LCRECORD (ht, ht_old);
 
   ht->hentries = xnew_array (htentry, ht_old->size + 1);
   memcpy (ht->hentries, ht_old->hentries, (ht_old->size + 1) * sizeof (htentry));
 
-  hash_table = wrap_hash_table (ht);
-
   if (! EQ (ht->next_weak, Qunbound))
     {
       ht->next_weak = Vall_weak_hash_tables;
-      Vall_weak_hash_tables = hash_table;
+      Vall_weak_hash_tables = obj;
     }
 
-  return hash_table;
+  return obj;
 }
 
 static void
 void
 init_elhash_once_early (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (hash_table);
+  INIT_LISP_OBJECT (hash_table);
 
   /* This must NOT be staticpro'd */
   Vall_weak_hash_tables = Qnil;
 	 The *only* thing that the syms_of_*() functions are allowed to do
 	 is call one of the following:
 
-	 INIT_LRECORD_IMPLEMENTATION()
+	 INIT_LISP_OBJECT()
 	 defsymbol(), DEFSYMBOL(), or DEFSYMBOL_MULTIWORD_PREDICATE()
 	 defsubr() (i.e. DEFSUBR)
 	 deferror(), DEFERROR(), or DEFERROR_STANDARD()
 	    - make_int()
 	    - make_char()
 	    - make_extent()
-	    - BASIC_ALLOC_LCRECORD()
-	    - ALLOC_LCRECORD_TYPE()
+	    - ALLOC_LISP_OBJECT()
+	    - ALLOC_SIZED_LISP_OBJECT()
 	    - Fcons()
 	    - listN()
             - make_lcrecord_list()
   { XD_END }
 };
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("subr", subr,
-				     1, /*dumpable-flag*/
+DEFINE_BASIC_LISP_OBJECT ("subr", subr,
 				     0, print_subr, 0, 0, 0,
 				     subr_description,
 				     Lisp_Subr);
 void
 syms_of_eval (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (subr);
+  INIT_LISP_OBJECT (subr);
 
   DEFSYMBOL (Qinhibit_quit);
   DEFSYMBOL (Qautoload);

File src/event-stream.c

    Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
    Copyright (C) 1995 Board of Trustees, University of Illinois.
    Copyright (C) 1995 Sun Microsystems, Inc.
-   Copyright (C) 1995, 1996, 2001, 2002, 2003 Ben Wing.
+   Copyright (C) 1995, 1996, 2001, 2002, 2003, 2005 Ben Wing.
 
 This file is part of XEmacs.
 
 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
 #define CONCHECK_COMMAND_BUILDER(x) CONCHECK_RECORD (x, command_builder)
 
-#ifndef MC_ALLOC
-static Lisp_Object Vcommand_builder_free_list;
-#endif /* not MC_ALLOC */
-
 static const struct memory_description command_builder_description [] = {
   { XD_LISP_OBJECT, offsetof (struct command_builder, current_events) },
   { XD_LISP_OBJECT, offsetof (struct command_builder, most_current_event) },
     }
 }
 
-DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder,
-			       0, /*dumpable-flag*/
-                               mark_command_builder, internal_object_printer,
-			       finalize_command_builder, 0, 0, 
-			       command_builder_description,
-			       struct command_builder);
+DEFINE_NONDUMPABLE_LISP_OBJECT ("command-builder", command_builder,
+					   mark_command_builder,
+					   0,
+					   finalize_command_builder, 0, 0, 
+					   command_builder_description,
+					   struct command_builder);
 
 static void
 reset_command_builder_event_chain (struct command_builder *builder)
 Lisp_Object
 allocate_command_builder (Lisp_Object console, int with_echo_buf)
 {
-  Lisp_Object builder_obj =
-#ifdef MC_ALLOC
-    wrap_pointer_1 (alloc_lrecord_type (struct command_builder,
-					 &lrecord_command_builder));
-#else /* not MC_ALLOC */
-    alloc_managed_lcrecord (Vcommand_builder_free_list);
-#endif /* not MC_ALLOC */
+  Lisp_Object builder_obj = ALLOC_LISP_OBJECT (command_builder);
   struct command_builder *builder = XCOMMAND_BUILDER (builder_obj);
 
   builder->console = console;
       xfree (builder->echo_buf, Ibyte *);
       builder->echo_buf = NULL;
     }
-#ifdef MC_ALLOC
-  free_lrecord (wrap_command_builder (builder));
-#else /* not MC_ALLOC */
-  free_managed_lcrecord (Vcommand_builder_free_list,
-			 wrap_command_builder (builder));
-#endif /* not MC_ALLOC */
+  FREE_LCRECORD (wrap_command_builder (builder));
 }
 
 static void
 
 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
 
-#ifndef MC_ALLOC
-static Lisp_Object Vtimeout_free_list;
-#endif /* not MC_ALLOC */
-
 static Lisp_Object
 mark_timeout (Lisp_Object obj)
 {
   { XD_END }
 };
 
-DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout,
-			       1, /*dumpable-flag*/
-			       mark_timeout, internal_object_printer,
-			       0, 0, 0, timeout_description, Lisp_Timeout);
+DEFINE_INTERNAL_LISP_OBJECT ("timeout", timeout, Lisp_Timeout,
+			     timeout_description, mark_timeout);
 
 /* Generate a timeout and return its ID. */
 
 			      Lisp_Object function, Lisp_Object object,
 			      int async_p)
 {
-#ifdef MC_ALLOC
-  Lisp_Object op = 
-    wrap_pointer_1 (alloc_lrecord_type (Lisp_Timeout, &lrecord_timeout));
-#else /* not MC_ALLOC */
-  Lisp_Object op = alloc_managed_lcrecord (Vtimeout_free_list);
-#endif /* not MC_ALLOC */
+  Lisp_Object op = ALLOC_LISP_OBJECT (timeout);
   Lisp_Timeout *timeout = XTIMEOUT (op);
   EMACS_TIME current_time;
   EMACS_TIME interval;
       *timeout_list = noseeum_cons (op, *timeout_list);
     }
   else
-#ifdef MC_ALLOC
-    free_lrecord (op);
-#else /* not MC_ALLOC */
-    free_managed_lcrecord (Vtimeout_free_list, op);
-#endif /* not MC_ALLOC */
+    FREE_LCRECORD (op);
 
   UNGCPRO;
   return id;
 	signal_remove_async_interval_timeout (timeout->interval_id);
       else
 	event_stream_remove_timeout (timeout->interval_id);
-#ifdef MC_ALLOC
-      free_lrecord (op);
-#else /* not MC_ALLOC */
-      free_managed_lcrecord (Vtimeout_free_list, op);
-#endif /* not MC_ALLOC */
+      FREE_LCRECORD (op);
     }
 }
 
 void
 syms_of_event_stream (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (command_builder);
-  INIT_LRECORD_IMPLEMENTATION (timeout);
+  INIT_LISP_OBJECT (command_builder);
+  INIT_LISP_OBJECT (timeout);
 
   DEFSYMBOL (Qdisabled);
   DEFSYMBOL (Qcommand_event_p);
   recent_keys_ring_index = 0;
   recent_keys_ring_size = 100;
   num_input_chars = 0;
-#ifndef MC_ALLOC
-  Vtimeout_free_list = make_lcrecord_list (sizeof (Lisp_Timeout),
-					   &lrecord_timeout);
-  staticpro_nodump (&Vtimeout_free_list);
-  Vcommand_builder_free_list =
-    make_lcrecord_list (sizeof (struct command_builder),
-			&lrecord_command_builder);
-  staticpro_nodump (&Vcommand_builder_free_list);
-#endif /* not MC_ALLOC */
   the_low_level_timeout_blocktype =
     Blocktype_new (struct low_level_timeout_blocktype);
   something_happened = 0;

File src/events.c

 
 #ifdef EVENT_DATA_AS_OBJECTS
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("key-data", key_data,
-				     0, /*dumpable-flag*/
-				     0, 0, 0, 0, 0,
-				     key_data_description, 
-				     Lisp_Key_Data);
+DEFINE_NONDUMPABLE_BASIC_LISP_OBJECT ("key-data", key_data,
+						 0, 0, 0, 0, 0,
+						 key_data_description, 
+						 Lisp_Key_Data);
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("button-data", button_data,
-				     0, /*dumpable-flag*/
-				     0, 0, 0, 0, 0,
-				     button_data_description, 
-				     Lisp_Button_Data);
+DEFINE_NONDUMPABLE_BASIC_LISP_OBJECT ("button-data", button_data,
+						 0, 0, 0, 0, 0,
+						 button_data_description, 
+						 Lisp_Button_Data);
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("motion-data", motion_data,
-				     0, /*dumpable-flag*/
-				     0, 0, 0, 0, 0,
-				     motion_data_description,
-				     Lisp_Motion_Data);
+DEFINE_NONDUMPABLE_BASIC_LISP_OBJECT ("motion-data", motion_data,
+						 0, 0, 0, 0, 0,
+						 motion_data_description,
+						 Lisp_Motion_Data);
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("process-data", process_data,
-				     0, /*dumpable-flag*/
-				     0, 0, 0, 0, 0,
-				     process_data_description,
-				     Lisp_Process_Data);