Mercurial > hg > xemacs-beta
changeset 5117:3742ea8250b5 ben-lisp-object ben-lisp-object-final-ws-year-2005
Checking in final CVS version of workspace 'ben-lisp-object'
line wrap: on
line diff
--- a/configure Sat Dec 26 00:20:16 2009 -0600 +++ b/configure Sat Dec 26 00:20:27 2009 -0600 @@ -37960,9 +37960,10 @@ # 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
--- a/lisp/ChangeLog Sat Dec 26 00:20:16 2009 -0600 +++ b/lisp/ChangeLog Sat Dec 26 00:20:27 2009 -0600 @@ -1,3 +1,28 @@ +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:
--- a/lisp/disp-table.el Sat Dec 26 00:20:16 2009 -0600 +++ b/lisp/disp-table.el Sat Dec 26 00:20:27 2009 -0600 @@ -2,8 +2,8 @@ ;; 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 @@ -28,15 +28,13 @@ ;;; 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: @@ -45,39 +43,54 @@ (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) @@ -91,19 +104,39 @@ ;;;###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 @@ -112,11 +145,62 @@ (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 @@ -129,7 +213,7 @@ (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 @@ -145,36 +229,30 @@ "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. @@ -184,8 +262,9 @@ "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) @@ -198,7 +277,7 @@ (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))
--- a/lisp/font.el Sat Dec 26 00:20:16 2009 -0600 +++ b/lisp/font.el Sat Dec 26 00:20:27 2009 -0600 @@ -2,7 +2,7 @@ ;; 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 @@ -245,16 +245,16 @@ (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))
--- a/modules/ldap/eldap.c Sat Dec 26 00:20:16 2009 -0600 +++ b/modules/ldap/eldap.c Sat Dec 26 00:20:27 2009 -0600 @@ -1,6 +1,6 @@ /* 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. @@ -162,10 +162,16 @@ 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 */ @@ -618,7 +624,6 @@ int rc; int i, j; Elemcount len; - Lisp_Object values = Qnil; struct gcpro gcpro1; @@ -717,7 +722,6 @@ int i, j, rc; Lisp_Object mod_op; Elemcount len; - Lisp_Object values = Qnil; struct gcpro gcpro1;
--- a/modules/postgresql/postgresql.c Sat Dec 26 00:20:16 2009 -0600 +++ b/modules/postgresql/postgresql.c Sat Dec 26 00:20:27 2009 -0600 @@ -266,16 +266,23 @@ #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 /****/
--- a/src/ChangeLog Sat Dec 26 00:20:16 2009 -0600 +++ b/src/ChangeLog Sat Dec 26 00:20:27 2009 -0600 @@ -1,3 +1,85 @@ +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):
--- a/src/alloc.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/alloc.c Sat Dec 26 00:20:27 2009 -0600 @@ -583,6 +583,13 @@ } #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 @@ -591,17 +598,16 @@ #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)); @@ -609,29 +615,33 @@ #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 @@ -650,20 +660,17 @@ 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); @@ -676,7 +683,15 @@ 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 */ @@ -1240,18 +1255,15 @@ { 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. @@ -1565,7 +1577,7 @@ { XD_END } }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("vector", vector, +DEFINE_SIZABLE_LISP_OBJECT ("vector", vector, 1, /*dumpable-flag*/ mark_vector, print_vector, 0, vector_equal, @@ -1579,8 +1591,8 @@ /* 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; @@ -1736,8 +1748,8 @@ 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; @@ -2298,8 +2310,7 @@ 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, @@ -2358,8 +2369,7 @@ } } -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, @@ -2883,7 +2893,7 @@ /************************************************************************/ /* 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. @@ -2896,11 +2906,9 @@ { 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 }, @@ -2945,11 +2953,11 @@ 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, @@ -3064,16 +3072,22 @@ 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 @@ -6164,12 +6178,12 @@ 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 *);
--- a/src/buffer.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/buffer.c Sat Dec 26 00:20:27 2009 -0600 @@ -319,11 +319,10 @@ /* 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. @@ -587,7 +586,8 @@ 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)); @@ -1888,7 +1888,7 @@ void syms_of_buffer (void) { - INIT_LRECORD_IMPLEMENTATION (buffer); + INIT_LISP_OBJECT (buffer); DEFSYMBOL (Qbuffer_live_p); DEFSYMBOL (Qbuffer_or_string_p); @@ -2120,7 +2120,7 @@ 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; \ @@ -2209,13 +2209,15 @@ { /* 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);
--- a/src/bytecode.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/bytecode.c Sat Dec 26 00:20:27 2009 -0600 @@ -2204,8 +2204,7 @@ } } -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, @@ -2214,8 +2213,7 @@ 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, @@ -2593,7 +2591,7 @@ 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);
--- a/src/casetab.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/casetab.c Sat Dec 26 00:20:27 2009 -0600 @@ -107,16 +107,15 @@ }; -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) { @@ -132,7 +131,7 @@ 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, /* @@ -495,7 +494,7 @@ void syms_of_casetab (void) { - INIT_LRECORD_IMPLEMENTATION (case_table); + INIT_LISP_OBJECT (case_table); DEFSYMBOL_MULTIWORD_PREDICATE (Qcase_tablep); DEFSYMBOL (Qdowncase);
--- a/src/chartab.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/chartab.c Sat Dec 26 00:20:27 2009 -0600 @@ -138,13 +138,12 @@ { 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 */ @@ -392,9 +391,8 @@ { 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); @@ -588,13 +586,11 @@ */ (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 @@ -624,13 +620,13 @@ 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 @@ -638,8 +634,8 @@ { 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++) { @@ -650,7 +646,7 @@ ctenew->level2[i] = new_; } - return wrap_char_table_entry (ctenew); + return obj; } #endif /* MULE */ @@ -668,12 +664,12 @@ 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++) { @@ -1817,10 +1813,10 @@ 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);
--- a/src/console.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/console.c Sat Dec 26 00:20:27 2009 -0600 @@ -172,11 +172,10 @@ 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 @@ -193,13 +192,12 @@ 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); @@ -1188,7 +1186,7 @@ void syms_of_console (void) { - INIT_LRECORD_IMPLEMENTATION (console); + INIT_LISP_OBJECT (console); DEFSUBR (Fvalid_console_type_p); DEFSUBR (Fconsole_type_list); @@ -1317,7 +1315,7 @@ 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; \ @@ -1393,13 +1391,15 @@ /* 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);
--- a/src/data.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/data.c Sat Dec 26 00:20:27 2009 -0600 @@ -1,7 +1,7 @@ /* 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. @@ -2575,13 +2575,11 @@ 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; @@ -2595,8 +2593,7 @@ { 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, @@ -3049,10 +3046,8 @@ 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); @@ -3066,12 +3061,10 @@ { 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. @@ -3269,24 +3262,23 @@ } 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; @@ -3307,12 +3299,11 @@ { 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. @@ -3450,9 +3441,9 @@ 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);
--- a/src/database.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/database.c Sat Dec 26 00:20:27 2009 -0600 @@ -131,7 +131,8 @@ 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; @@ -194,12 +195,11 @@ 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. @@ -816,7 +816,7 @@ void syms_of_database (void) { - INIT_LRECORD_IMPLEMENTATION (database); + INIT_LISP_OBJECT (database); DEFSYMBOL (Qdatabasep); #ifdef HAVE_DBM
--- a/src/device-msw.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/device-msw.c Sat Dec 26 00:20:27 2009 -0600 @@ -1175,20 +1175,19 @@ 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); @@ -1207,7 +1206,7 @@ dm->devmode = src_devmode; } - return wrap_devmode (dm); + return obj; } DEFUN ("msprinter-settings-copy", Fmsprinter_settings_copy, 1, 1, 0, /* @@ -1343,7 +1342,7 @@ void syms_of_device_mswindows (void) { - INIT_LRECORD_IMPLEMENTATION (devmode); + INIT_LISP_OBJECT (devmode); DEFSUBR (Fmsprinter_get_settings); DEFSUBR (Fmsprinter_select_settings);
--- a/src/device.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/device.c Sat Dec 26 00:20:27 2009 -0600 @@ -155,11 +155,10 @@ 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_) @@ -196,12 +195,11 @@ 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); @@ -1384,7 +1382,7 @@ void syms_of_device (void) { - INIT_LRECORD_IMPLEMENTATION (device); + INIT_LISP_OBJECT (device); DEFSUBR (Fvalid_device_class_p); DEFSUBR (Fdevice_class_list);
--- a/src/dialog-msw.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/dialog-msw.c Sat Dec 26 00:20:27 2009 -0600 @@ -183,12 +183,11 @@ 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 @@ -748,13 +747,9 @@ 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); @@ -767,16 +762,16 @@ 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; } } @@ -814,7 +809,7 @@ 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);
--- a/src/elhash.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/elhash.c Sat Dec 26 00:20:27 2009 -0600 @@ -472,9 +472,8 @@ { 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, @@ -549,8 +548,8 @@ 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; @@ -574,8 +573,6 @@ /* 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 @@ -967,21 +964,20 @@ (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 @@ -1760,7 +1756,7 @@ 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;
--- a/src/emacs.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/emacs.c Sat Dec 26 00:20:27 2009 -0600 @@ -1429,7 +1429,7 @@ 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() @@ -1973,8 +1973,8 @@ - make_int() - make_char() - make_extent() - - BASIC_ALLOC_LCRECORD() - - ALLOC_LCRECORD_TYPE() + - ALLOC_LISP_OBJECT() + - ALLOC_SIZED_LISP_OBJECT() - Fcons() - listN() - make_lcrecord_list()
--- a/src/eval.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/eval.c Sat Dec 26 00:20:27 2009 -0600 @@ -433,8 +433,7 @@ { 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); @@ -6439,7 +6438,7 @@ void syms_of_eval (void) { - INIT_LRECORD_IMPLEMENTATION (subr); + INIT_LISP_OBJECT (subr); DEFSYMBOL (Qinhibit_quit); DEFSYMBOL (Qautoload);
--- a/src/event-stream.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/event-stream.c Sat Dec 26 00:20:27 2009 -0600 @@ -2,7 +2,7 @@ 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. @@ -329,10 +329,6 @@ #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) }, @@ -368,12 +364,12 @@ } } -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) @@ -388,13 +384,7 @@ 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; @@ -463,12 +453,7 @@ 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 @@ -1031,10 +1016,6 @@ 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) { @@ -1049,10 +1030,8 @@ { 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. */ @@ -1062,12 +1041,7 @@ 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; @@ -1185,11 +1159,7 @@ *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; @@ -1226,11 +1196,7 @@ 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); } } @@ -4870,8 +4836,8 @@ 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); @@ -4925,15 +4891,6 @@ 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;
--- a/src/events.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/events.c Sat Dec 26 00:20:27 2009 -0600 @@ -224,59 +224,50 @@ #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); +DEFINE_NONDUMPABLE_BASIC_LISP_OBJECT ("process-data", process_data, + 0, 0, 0, 0, 0, + process_data_description, + Lisp_Process_Data); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("timeout-data", timeout_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - timeout_data_description, - Lisp_Timeout_Data); +DEFINE_NONDUMPABLE_BASIC_LISP_OBJECT ("timeout-data", timeout_data, + 0, 0, 0, 0, 0, + timeout_data_description, + Lisp_Timeout_Data); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("eval-data", eval_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - eval_data_description, - Lisp_Eval_Data); +DEFINE_NONDUMPABLE_BASIC_LISP_OBJECT ("eval-data", eval_data, + 0, 0, 0, 0, 0, + eval_data_description, + Lisp_Eval_Data); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("misc-user-data", misc_user_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - misc_user_data_description, - Lisp_Misc_User_Data); +DEFINE_NONDUMPABLE_BASIC_LISP_OBJECT ("misc-user-data", misc_user_data, + 0, 0, 0, 0, 0, + misc_user_data_description, + Lisp_Misc_User_Data); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("magic-eval-data", magic_eval_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - magic_eval_data_description, - Lisp_Magic_Eval_Data); +DEFINE_NONDUMPABLE_BASIC_LISP_OBJECT ("magic-eval-data", magic_eval_data, + 0, 0, 0, 0, 0, + magic_eval_data_description, + Lisp_Magic_Eval_Data); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("magic-data", magic_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - magic_data_description, - Lisp_Magic_Data); +DEFINE_NONDUMPABLE_BASIC_LISP_OBJECT ("magic-data", magic_data, + 0, 0, 0, 0, 0, + magic_data_description, + Lisp_Magic_Data); #endif /* EVENT_DATA_AS_OBJECTS */ @@ -518,11 +509,11 @@ return 0; /* unreached */ } -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event, - 0, /*dumpable-flag*/ - mark_event, print_event, 0, event_equal, - event_hash, event_description, - Lisp_Event); +DEFINE_NONDUMPABLE_BASIC_LISP_OBJECT ("event", event, + mark_event, print_event, 0, + event_equal, event_hash, + event_description, + Lisp_Event); DEFUN ("make-event", Fmake_event, 0, 2, 0, /* Return a new event of type TYPE, with properties described by PLIST. @@ -2568,17 +2559,17 @@ void syms_of_events (void) { - INIT_LRECORD_IMPLEMENTATION (event); + INIT_LISP_OBJECT (event); #ifdef EVENT_DATA_AS_OBJECTS - INIT_LRECORD_IMPLEMENTATION (key_data); - INIT_LRECORD_IMPLEMENTATION (button_data); - INIT_LRECORD_IMPLEMENTATION (motion_data); - INIT_LRECORD_IMPLEMENTATION (process_data); - INIT_LRECORD_IMPLEMENTATION (timeout_data); - INIT_LRECORD_IMPLEMENTATION (eval_data); - INIT_LRECORD_IMPLEMENTATION (misc_user_data); - INIT_LRECORD_IMPLEMENTATION (magic_eval_data); - INIT_LRECORD_IMPLEMENTATION (magic_data); + INIT_LISP_OBJECT (key_data); + INIT_LISP_OBJECT (button_data); + INIT_LISP_OBJECT (motion_data); + INIT_LISP_OBJECT (process_data); + INIT_LISP_OBJECT (timeout_data); + INIT_LISP_OBJECT (eval_data); + INIT_LISP_OBJECT (misc_user_data); + INIT_LISP_OBJECT (magic_eval_data); + INIT_LISP_OBJECT (magic_data); #endif /* EVENT_DATA_AS_OBJECTS */ DEFSUBR (Fcharacter_to_event);
--- a/src/extents.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/extents.c Sat Dec 26 00:20:27 2009 -0600 @@ -977,20 +977,19 @@ return data->parent; } -DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary, - 0, /*dumpable-flag*/ - mark_extent_auxiliary, internal_object_printer, - 0, 0, 0, extent_auxiliary_description, - struct extent_auxiliary); +DEFINE_NONDUMPABLE_INTERNAL_LISP_OBJECT ("extent-auxiliary", + extent_auxiliary, + struct extent_auxiliary, + extent_auxiliary_description, + mark_extent_auxiliary); void allocate_extent_auxiliary (EXTENT ext) { - Lisp_Object extent_aux; - struct extent_auxiliary *data = - ALLOC_LCRECORD_TYPE (struct extent_auxiliary, &lrecord_extent_auxiliary); + Lisp_Object obj = ALLOC_LISP_OBJECT (extent_auxiliary); + struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj); + COPY_LCRECORD (data, &extent_auxiliary_defaults); - extent_aux = wrap_extent_auxiliary (data); - ext->plist = Fcons (extent_aux, ext->plist); + ext->plist = Fcons (obj, ext->plist); ext->flags.has_aux = 1; } @@ -1154,24 +1153,21 @@ } } -DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info, - 0, /*dumpable-flag*/ - mark_extent_info, internal_object_printer, - finalize_extent_info, 0, 0, - extent_info_description, - struct extent_info); +DEFINE_NONDUMPABLE_LISP_OBJECT ("extent-info", extent_info, + mark_extent_info, 0, + finalize_extent_info, 0, 0, + extent_info_description, + struct extent_info); static Lisp_Object allocate_extent_info (void) { - Lisp_Object extent_info; - struct extent_info *data = - ALLOC_LCRECORD_TYPE (struct extent_info, &lrecord_extent_info); - - extent_info = wrap_extent_info (data); + Lisp_Object obj = ALLOC_LISP_OBJECT (extent_info); + struct extent_info *data = XEXTENT_INFO (obj); + data->extents = allocate_extent_list (); data->soe = 0; - return extent_info; + return obj; } void @@ -3317,8 +3313,7 @@ return Fextent_properties (obj); } -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent, - 1, /*dumpable-flag*/ +DEFINE_BASIC_LISP_OBJECT_WITH_PROPS ("extent", extent, mark_extent, print_extent, /* NOTE: If you declare a @@ -3897,12 +3892,11 @@ /* also need to copy the aux struct. It won't work for this extent to share the same aux struct as the original one. */ - struct extent_auxiliary *data = - ALLOC_LCRECORD_TYPE (struct extent_auxiliary, - &lrecord_extent_auxiliary); + Lisp_Object ea = ALLOC_LISP_OBJECT (extent_auxiliary); + struct extent_auxiliary *data = XEXTENT_AUXILIARY (ea); COPY_LCRECORD (data, XEXTENT_AUXILIARY (XCAR (original->plist))); - XCAR (e->plist) = wrap_extent_auxiliary (data); + XCAR (e->plist) = ea; } { @@ -7296,9 +7290,9 @@ void syms_of_extents (void) { - INIT_LRECORD_IMPLEMENTATION (extent); - INIT_LRECORD_IMPLEMENTATION (extent_info); - INIT_LRECORD_IMPLEMENTATION (extent_auxiliary); + INIT_LISP_OBJECT (extent); + INIT_LISP_OBJECT (extent_info); + INIT_LISP_OBJECT (extent_auxiliary); DEFSYMBOL (Qextentp); DEFSYMBOL (Qextent_live_p);
--- a/src/faces.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/faces.c Sat Dec 26 00:20:27 2009 -0600 @@ -278,8 +278,7 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face, - 1, /*dumpable-flag*/ +DEFINE_LISP_OBJECT_WITH_PROPS ("face", face, mark_face, print_face, 0, face_equal, face_hash, face_description, face_getprop, @@ -373,7 +372,8 @@ static Lisp_Face * allocate_face (void) { - Lisp_Face *result = ALLOC_LCRECORD_TYPE (Lisp_Face, &lrecord_face); + Lisp_Object obj = ALLOC_LISP_OBJECT (face); + Lisp_Face *result = XFACE (obj); reset_face (result); return result; @@ -1858,7 +1858,7 @@ void syms_of_faces (void) { - INIT_LRECORD_IMPLEMENTATION (face); + INIT_LISP_OBJECT (face); /* Qdefault, Qwidget, Qleft_margin, Qright_margin defined in general.c */ DEFSYMBOL (Qmodeline);
--- a/src/file-coding.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/file-coding.c Sat Dec 26 00:20:27 2009 -0600 @@ -366,14 +366,13 @@ 0, coding_system_empty_extra_description_1 }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("coding-system", coding_system, - 1, /*dumpable-flag*/ - mark_coding_system, - print_coding_system, - finalize_coding_system, - 0, 0, coding_system_description, - sizeof_coding_system, - Lisp_Coding_System); +DEFINE_SIZABLE_LISP_OBJECT ("coding-system", coding_system, + mark_coding_system, + print_coding_system, + finalize_coding_system, + 0, 0, coding_system_description, + sizeof_coding_system, + Lisp_Coding_System); /************************************************************************/ /* Creating coding systems */ @@ -697,9 +696,8 @@ Lisp_Object name) { Bytecount total_size = offsetof (Lisp_Coding_System, data) + data_size; - Lisp_Coding_System *codesys = - (Lisp_Coding_System *) BASIC_ALLOC_LCRECORD (total_size, - &lrecord_coding_system); + Lisp_Object obj = ALLOC_SIZED_LISP_OBJECT (total_size, coding_system); + Lisp_Coding_System *codesys = XCODING_SYSTEM (obj); codesys->methods = codesys_meths; #define MARKED_SLOT(x) codesys->x = Qnil; @@ -4358,7 +4356,7 @@ void syms_of_file_coding (void) { - INIT_LRECORD_IMPLEMENTATION (coding_system); + INIT_LISP_OBJECT (coding_system); DEFSUBR (Fvalid_coding_system_type_p); DEFSUBR (Fcoding_system_type_list);
--- a/src/floatfns.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/floatfns.c Sat Dec 26 00:20:27 2009 -0600 @@ -196,8 +196,7 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("float", float, - 1, /*dumpable-flag*/ +DEFINE_BASIC_LISP_OBJECT ("float", float, mark_float, print_float, 0, float_equal, float_hash, float_description, Lisp_Float); @@ -1258,7 +1257,7 @@ void syms_of_floatfns (void) { - INIT_LRECORD_IMPLEMENTATION (float); + INIT_LISP_OBJECT (float); /* Trig functions. */
--- a/src/fns.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/fns.c Sat Dec 26 00:20:27 2009 -0600 @@ -129,15 +129,14 @@ }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("bit-vector", bit_vector, - 1, /*dumpable-flag*/ - mark_bit_vector, - print_bit_vector, 0, - bit_vector_equal, - bit_vector_hash, - bit_vector_description, - size_bit_vector, - Lisp_Bit_Vector); +DEFINE_SIZABLE_LISP_OBJECT ("bit-vector", bit_vector, + mark_bit_vector, + print_bit_vector, 0, + bit_vector_equal, + bit_vector_hash, + bit_vector_description, + size_bit_vector, + Lisp_Bit_Vector); DEFUN ("identity", Fidentity, 1, 1, 0, /* @@ -4002,7 +4001,7 @@ void syms_of_fns (void) { - INIT_LRECORD_IMPLEMENTATION (bit_vector); + INIT_LISP_OBJECT (bit_vector); DEFSYMBOL (Qstring_lessp); DEFSYMBOL (Qidentity);
--- a/src/frame.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/frame.c Sat Dec 26 00:20:27 2009 -0600 @@ -250,11 +250,10 @@ write_fmt_string (printcharfun, " 0x%x>", frm->header.uid); } -DEFINE_LRECORD_IMPLEMENTATION ("frame", frame, - 0, /*dumpable-flag*/ - mark_frame, print_frame, 0, 0, 0, - frame_description, - struct frame); +DEFINE_NONDUMPABLE_LISP_OBJECT ("frame", frame, + mark_frame, print_frame, 0, 0, 0, + frame_description, + struct frame); static void nuke_all_frame_slots (struct frame *f) @@ -273,12 +272,11 @@ allocate_frame_core (Lisp_Object device) { /* This function can GC */ - Lisp_Object frame; Lisp_Object root_window; - struct frame *f = ALLOC_LCRECORD_TYPE (struct frame, &lrecord_frame); + Lisp_Object frame = ALLOC_LISP_OBJECT (frame); + struct frame *f = XFRAME (frame); nuke_all_frame_slots (f); - frame = wrap_frame (f); f->device = device; f->framemeths = XDEVICE (device)->devmeths; @@ -3575,7 +3573,7 @@ void syms_of_frame (void) { - INIT_LRECORD_IMPLEMENTATION (frame); + INIT_LISP_OBJECT (frame); DEFSYMBOL (Qdelete_frame_hook); DEFSYMBOL (Qselect_frame_hook);
--- a/src/glyphs.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/glyphs.c Sat Dec 26 00:20:27 2009 -0600 @@ -1313,21 +1313,19 @@ 0)); } -DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance, - 0, /*dumpable-flag*/ - mark_image_instance, print_image_instance, - finalize_image_instance, image_instance_equal, - image_instance_hash, - image_instance_description, - Lisp_Image_Instance); +DEFINE_NONDUMPABLE_LISP_OBJECT ("image-instance", image_instance, + mark_image_instance, print_image_instance, + finalize_image_instance, image_instance_equal, + image_instance_hash, + image_instance_description, + Lisp_Image_Instance); static Lisp_Object allocate_image_instance (Lisp_Object governing_domain, Lisp_Object parent, Lisp_Object instantiator) { - Lisp_Image_Instance *lp = - ALLOC_LCRECORD_TYPE (Lisp_Image_Instance, &lrecord_image_instance); - Lisp_Object val; + Lisp_Object obj = ALLOC_LISP_OBJECT (image_instance); + Lisp_Image_Instance *lp = XIMAGE_INSTANCE (obj); /* It's not possible to simply keep a record of the domain in which the instance was instantiated. This is because caching may mean @@ -1350,10 +1348,9 @@ /* So that layouts get done. */ lp->layout_changed = 1; - val = wrap_image_instance (lp); MARK_GLYPHS_CHANGED; - return val; + return obj; } static enum image_instance_type @@ -3790,8 +3787,7 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph, - 1, /*dumpable-flag*/ +DEFINE_LISP_OBJECT_WITH_PROPS ("glyph", glyph, mark_glyph, print_glyph, 0, glyph_equal, glyph_hash, glyph_description, @@ -3805,8 +3801,8 @@ Lisp_Object locale)) { /* This function can GC */ - Lisp_Object obj = Qnil; - Lisp_Glyph *g = ALLOC_LCRECORD_TYPE (Lisp_Glyph, &lrecord_glyph); + Lisp_Object obj = ALLOC_LISP_OBJECT (glyph); + Lisp_Glyph *g = XGLYPH (obj); g->type = type; g->image = Fmake_specifier (Qimage); /* This function can GC */ @@ -3852,7 +3848,6 @@ g->face = Qnil; g->plist = Qnil; g->after_change = after_change; - obj = wrap_glyph (g); set_image_attached_to (g->image, obj, Qimage); UNGCPRO; @@ -5123,8 +5118,8 @@ void syms_of_glyphs (void) { - INIT_LRECORD_IMPLEMENTATION (glyph); - INIT_LRECORD_IMPLEMENTATION (image_instance); + INIT_LISP_OBJECT (glyph); + INIT_LISP_OBJECT (image_instance); /* image instantiators */
--- a/src/gui.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/gui.c Sat Dec 26 00:20:27 2009 -0600 @@ -197,14 +197,10 @@ Lisp_Object allocate_gui_item (void) { - Lisp_Gui_Item *lp = ALLOC_LCRECORD_TYPE (Lisp_Gui_Item, &lrecord_gui_item); - Lisp_Object val; + Lisp_Object obj = ALLOC_LISP_OBJECT (gui_item); - val = wrap_gui_item (lp); - - gui_item_init (val); - - return val; + gui_item_init (obj); + return obj; } /* @@ -809,13 +805,12 @@ { } -DEFINE_LRECORD_IMPLEMENTATION ("gui-item", gui_item, - 0, /*dumpable-flag*/ - mark_gui_item, print_gui_item, - finalize_gui_item, gui_item_equal, - gui_item_hash, - gui_item_description, - Lisp_Gui_Item); +DEFINE_NONDUMPABLE_LISP_OBJECT ("gui-item", gui_item, + mark_gui_item, print_gui_item, + finalize_gui_item, gui_item_equal, + gui_item_hash, + gui_item_description, + Lisp_Gui_Item); DOESNT_RETURN gui_error (const Ascbyte *reason, Lisp_Object frob) @@ -832,7 +827,7 @@ void syms_of_gui (void) { - INIT_LRECORD_IMPLEMENTATION (gui_item); + INIT_LISP_OBJECT (gui_item); DEFSYMBOL (Qmenu_no_selection_hook);
--- a/src/keymap.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/keymap.c Sat Dec 26 00:20:27 2009 -0600 @@ -282,9 +282,8 @@ }; /* No need for keymap_equal #### Why not? */ -DEFINE_LRECORD_IMPLEMENTATION ("keymap", keymap, - 1, /*dumpable-flag*/ - mark_keymap, print_keymap, 0, 0, 0, +DEFINE_LISP_OBJECT ("keymap", keymap, + mark_keymap, print_keymap, 0, 0, 0, keymap_description, Lisp_Keymap); @@ -755,10 +754,8 @@ static Lisp_Object make_keymap (Elemcount size) { - Lisp_Object result; - Lisp_Keymap *keymap = ALLOC_LCRECORD_TYPE (Lisp_Keymap, &lrecord_keymap); - - result = wrap_keymap (keymap); + Lisp_Object obj = ALLOC_LISP_OBJECT (keymap); + Lisp_Keymap *keymap = XKEYMAP (obj); keymap->parents = Qnil; keymap->prompt = Qnil; @@ -778,7 +775,7 @@ make_lisp_hash_table (size * 3 / 4, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); } - return result; + return obj; } DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /* @@ -4306,7 +4303,7 @@ void syms_of_keymap (void) { - INIT_LRECORD_IMPLEMENTATION (keymap); + INIT_LISP_OBJECT (keymap); DEFSYMBOL (Qminor_mode_map_alist);
--- a/src/lisp.h Sat Dec 26 00:20:16 2009 -0600 +++ b/src/lisp.h Sat Dec 26 00:20:27 2009 -0600 @@ -4797,7 +4797,8 @@ Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object); void float_to_string (char *, double); -void internal_object_printer (Lisp_Object, Lisp_Object, int); +void external_object_printer (Lisp_Object obj, Lisp_Object printcharfun, + int UNUSED (escapeflag)); /* Defined in rangetab.c */ EXFUN (Fclear_range_table, 1);
--- a/src/lrecord.h Sat Dec 26 00:20:16 2009 -0600 +++ b/src/lrecord.h Sat Dec 26 00:20:27 2009 -0600 @@ -82,6 +82,9 @@ #endif /* not MC_ALLOC */ #ifdef MC_ALLOC +#define ALLOC_LISP_OBJECT(type) alloc_lrecord (&lrecord_##type) +#define ALLOC_SIZED_LISP_OBJECT(size, type) \ + alloc_sized_lrecord (size, &lrecord_##type) #define ALLOC_LCRECORD_TYPE alloc_lrecord_type #define COPY_SIZED_LCRECORD copy_sized_lrecord #define COPY_LCRECORD copy_lrecord @@ -89,16 +92,17 @@ mc_alloced_storage_size (size, stats) #define ZERO_LCRECORD zero_lrecord #define LCRECORD_HEADER lrecord_header -#define BASIC_ALLOC_LCRECORD alloc_lrecord #define FREE_LCRECORD free_lrecord #else +#define ALLOC_LISP_OBJECT(type) alloc_lcrecord (&lrecord_##type) +#define ALLOC_SIZED_LISP_OBJECT(size, type) \ + old_alloc_sized_lcrecord (size, &lrecord_##type) #define ALLOC_LCRECORD_TYPE old_alloc_lcrecord_type #define COPY_SIZED_LCRECORD old_copy_sized_lcrecord #define COPY_LCRECORD old_copy_lcrecord #define LISPOBJ_STORAGE_SIZE malloced_storage_size #define ZERO_LCRECORD old_zero_lcrecord #define LCRECORD_HEADER old_lcrecord_header -#define BASIC_ALLOC_LCRECORD old_basic_alloc_lcrecord #define FREE_LCRECORD old_free_lcrecord #endif @@ -178,7 +182,7 @@ /* The `next' field is normally used to chain all lcrecords together so that the GC can find (and free) all of them. - `old_basic_alloc_lcrecord' threads lcrecords together. + `old_alloc_sized_lcrecord' threads lcrecords together. The `next' field may be used for other purposes as long as some other mechanism is provided for letting the GC do its work. @@ -330,7 +334,7 @@ Lisp_Object (*marker) (Lisp_Object); /* `printer' converts the object to a printed representation. - This can be NULL; in this case default_object_printer() will be + This can be NULL; in this case internal_object_printer() will be used instead. */ void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag); @@ -367,13 +371,10 @@ int (*remprop) (Lisp_Object obj, Lisp_Object prop); Lisp_Object (*plist) (Lisp_Object obj); -#ifdef MC_ALLOC - /* Only one of `static_size' and `size_in_bytes_method' is non-0. */ -#else /* not MC_ALLOC */ - /* Only one of `static_size' and `size_in_bytes_method' is non-0. - If both are 0, this type is not instantiable by - old_basic_alloc_lcrecord(). */ -#endif /* not MC_ALLOC */ + /* Only one of `static_size' and `size_in_bytes_method' is non-0. If + `static_size' is 0, this type is not instantiable by + ALLOC_LISP_OBJECT(). If both are 0 (this should never happen), this + object cannot be instantiated; you will get an abort() if you try.*/ Bytecount static_size; Bytecount (*size_in_bytes_method) (const void *header); @@ -1088,8 +1089,22 @@ { XD_INT, offsetof (base_type, cur) }, \ { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) } \ -/* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size. - DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies. +/* DEFINE_LISP_OBJECT is for objects with constant size. + + DEFINE_SIZABLE_LISP_OBJECT is for objects whose size varies. + + DEFINE_FROB_BLOCK_LISP_OBJECT is for objects that are allocated in + large blocks ("frob blocks"), which are parceled up individually. Such + objects need special handling in alloc.c. This does not apply to + MC_ALLOC, because it does this automatically. + + DEFINE_*_WITH_PROPS is for objects which support the unified property + interface using `get', `put', `remprop' and `object-plist'. + + DEFINE_EXTERNAL_* is for objects defined in an external module. + + MAKE_LISP_OBJECT is what underlies all of these; it defines + */ #if defined (ERROR_CHECK_TYPES) @@ -1098,58 +1113,66 @@ # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype) #endif - -#define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) - -#define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ -MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype) +#error MUST STILL SUPPORT THIS::: #define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) -#define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ -MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) +#error and variations + +#define DEFINE_INTERNAL_LISP_OBJECT(name,c_name,dumpable,structtype,desc,marker) ... -#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) +#define DEFINE_FROB_BLOCK_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ +DEFINE_FROB_BLOCK_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) + +#define DEFINE_FROB_BLOCK_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ +MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype) -#define DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ -MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,1,structtype) +#define DEFINE_INTERNAL_LISP_OBJECT(name,c_name,structtype,desc,dumpable,marker) \ +DEFINE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,) + +#define DEFINE_LISP_OBJECT(name,c_name,structtype,desc,dumpable,marker,printer,equal,hash,nuker) \ +DEFINE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,) -#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \ -MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) +#define DEFINE_LISP_OBJECT_WITH_PROPS(name,c_name,structtype,dumpable,desc,marker,printer,equal,hash,nuker,getprop,putprop,remprop,plist) \ +MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) + +#define DEFINE_SIZABLE_LISP_OBJECT(name,c_name,structtype,sizer,desc,dumpable,marker,printer,equal,hash,nuker) \ +DEFINE_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) + +#define DEFINE_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,structtype,sizer,desc,dumpable,marker,printer,equal,hash,nuker,getprop,putprop,remprop,plist) \ +MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) #ifdef MC_ALLOC -#define MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ +#define MAKE_LISP_OBJECT(name,c_name,structtype,sizer,desc,dumpable,marker,printer,equal,hash,nuker,getprop,putprop,remprop,plist,frob_block) \ DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ const struct lrecord_implementation lrecord_##c_name = \ { name, dumpable, marker, printer, nuker, equal, hash, desc, \ getprop, putprop, remprop, plist, size, sizer, \ lrecord_type_##c_name } #else /* not MC_ALLOC */ -#define MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ +#define MAKE_LISP_OBJECT(name,c_name,structtype,sizer,desc,dumpable,marker,printer,equal,hash,nuker,getprop,putprop,remprop,plist,frob_block) \ DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ const struct lrecord_implementation lrecord_##c_name = \ { name, dumpable, marker, printer, nuker, equal, hash, desc, \ getprop, putprop, remprop, plist, size, sizer, \ - lrecord_type_##c_name, basic_p } + lrecord_type_##c_name, frob_block } #endif /* not MC_ALLOC */ -#define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ -DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) +#define DEFINE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ +DEFINE_EXTERNAL_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) -#define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ -MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) +#define DEFINE_EXTERNAL_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ +MAKE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) -#define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ -DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) +#define DEFINE_EXTERNAL_SIZABLE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +DEFINE_EXTERNAL_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) -#define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \ -MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) +#define DEFINE_EXTERNAL_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \ +MAKE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) #ifdef MC_ALLOC -#define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ +#define MAKE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ int lrecord_type_##c_name; \ struct lrecord_implementation lrecord_##c_name = \ @@ -1157,7 +1180,7 @@ getprop, putprop, remprop, plist, size, sizer, \ lrecord_type_last_built_in_type } #else /* not MC_ALLOC */ -#define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ +#define MAKE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ int lrecord_type_##c_name; \ struct lrecord_implementation lrecord_##c_name = \ @@ -1169,7 +1192,7 @@ #ifdef USE_KKCC extern MODULE_API const struct memory_description *lrecord_memory_descriptions[]; -#define INIT_LRECORD_IMPLEMENTATION(type) do { \ +#define INIT_LISP_OBJECT(type) do { \ lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \ lrecord_memory_descriptions[lrecord_type_##type] = \ lrecord_implementations_table[lrecord_type_##type]->description; \ @@ -1177,40 +1200,40 @@ #else /* not USE_KKCC */ extern MODULE_API Lisp_Object (*lrecord_markers[]) (Lisp_Object); -#define INIT_LRECORD_IMPLEMENTATION(type) do { \ +#define INIT_LISP_OBJECT(type) do { \ lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \ lrecord_markers[lrecord_type_##type] = \ lrecord_implementations_table[lrecord_type_##type]->marker; \ } while (0) #endif /* not USE_KKCC */ -#define INIT_EXTERNAL_LRECORD_IMPLEMENTATION(type) do { \ +#define INIT_EXTERNAL_LISP_OBJECT(type) do { \ lrecord_type_##type = lrecord_type_count++; \ lrecord_##type.lrecord_type_index = lrecord_type_##type; \ - INIT_LRECORD_IMPLEMENTATION(type); \ + INIT_LISP_OBJECT(type); \ } while (0) #ifdef HAVE_SHLIB /* Allow undefining types in order to support module unloading. */ #ifdef USE_KKCC -#define UNDEF_LRECORD_IMPLEMENTATION(type) do { \ +#define UNDEF_LISP_OBJECT(type) do { \ lrecord_implementations_table[lrecord_type_##type] = NULL; \ lrecord_memory_descriptions[lrecord_type_##type] = NULL; \ } while (0) #else /* not USE_KKCC */ -#define UNDEF_LRECORD_IMPLEMENTATION(type) do { \ +#define UNDEF_LISP_OBJECT(type) do { \ lrecord_implementations_table[lrecord_type_##type] = NULL; \ lrecord_markers[lrecord_type_##type] = NULL; \ } while (0) #endif /* not USE_KKCC */ -#define UNDEF_EXTERNAL_LRECORD_IMPLEMENTATION(type) do { \ +#define UNDEF_EXTERNAL_LISP_OBJECT(type) do { \ if (lrecord_##type.lrecord_type_index == lrecord_type_count - 1) { \ /* This is the most recently defined type. Clean up nicely. */ \ lrecord_type_##type = lrecord_type_count--; \ } /* Else we can't help leaving a hole with this implementation. */ \ - UNDEF_LRECORD_IMPLEMENTATION(type); \ + UNDEF_LISP_OBJECT(type); \ } while (0) #endif /* HAVE_SHLIB */ @@ -1241,12 +1264,12 @@ describing the purpose of the descriptions; and comments elsewhere in this file describing the exact syntax of the description structures. - 6. Define your object with DEFINE_LRECORD_IMPLEMENTATION() or some + 6. Define your object with DEFINE_LISP_OBJECT() or some variant. 7. Include the header file in the .c file where you defined the object. - 8. Put a call to INIT_LRECORD_IMPLEMENTATION() for the object in the + 8. Put a call to INIT_LISP_OBJECT() for the object in the .c file's syms_of_foo() function. 9. Add a type enum for the object to enum lrecord_type, earlier in this @@ -1336,20 +1359,18 @@ return data->help_string; } -[[ If your object should never escape to Lisp, declare its print method - as internal_object_printer instead of 0. ]] - -DEFINE_LRECORD_IMPLEMENTATION ("toolbar-button", toolbar_button, - 0, mark_toolbar_button, 0, 0, 0, 0, - toolbar_button_description, - struct toolbar_button); +DEFINE_NONDUMPABLE_LISP_OBJECT ("toolbar-button", toolbar_button, + mark_toolbar_button, + external_object_printer, 0, 0, 0, + toolbar_button_description, + struct toolbar_button); ... void syms_of_toolbar (void) { - INIT_LRECORD_IMPLEMENTATION (toolbar_button); + INIT_LISP_OBJECT (toolbar_button); ...; } @@ -1378,8 +1399,8 @@ Note: Object types defined in external dynamically-loaded modules (not part of the XEmacs main source code) should use DECLARE_EXTERNAL_LRECORD -and DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION rather than DECLARE_LRECORD -and DEFINE_LRECORD_IMPLEMENTATION. The EXTERNAL versions declare and +and DEFINE_EXTERNAL_LISP_OBJECT rather than DECLARE_LRECORD +and DEFINE_LISP_OBJECT. The EXTERNAL versions declare and allocate an enumerator for the type being defined. */ @@ -1520,6 +1541,26 @@ dead_wrong_type_argument (predicate, x); \ } while (0) +/* How to allocate a Lisp object: + + - For most objects, simply call ALLOC_LISP_OBJECT (type), where TYPE is + the name of the type (e.g. toolbar_button). Such objects can be freed + manually using FREE_LCRECORD. + + - For objects whose size can vary (and hence which have a + size_in_bytes_method rather than a static_size), call + ALLOC_SIZED_LISP_OBJECT (size, type), where TYPE is the + name of the type. NOTE: You cannot call FREE_LCRECORD() on such + on object! (At least when not MC_ALLOC) + + - Basic lrecords (of which there are a limited number, which exist only + when not MC_ALLOC, and which have special handling in alloc.c) need + special handling; if you don't understand this, just ignore it. + + - Some lrecords, which are used totally internally, use the + noseeum-* functions for the reason of debugging. + */ + #ifndef MC_ALLOC /*-------------------------- lcrecord-list -----------------------------*/ @@ -1560,7 +1601,7 @@ in particular dictate the various types of management: -- "Auto-managed" means that you just go ahead and allocate the lcrecord - whenever you want, using old_alloc_lcrecord_type(), and the appropriate + whenever you want, using ALLOC_LISP_OBJECT(), and the appropriate lcrecord-list manager is automatically created. To free, you just call "FREE_LCRECORD()" and the appropriate lcrecord-list manager is automatically located and called. The limitation here of course is that @@ -1583,7 +1624,7 @@ to hand-manage them, or (b) the objects you create are always or almost always Lisp-visible, and thus there's no point in freeing them (and it wouldn't be safe to do so). You just create them with - BASIC_ALLOC_LCRECORD(), and that's it. + ALLOC_SIZED_LISP_OBJECT(), and that's it. --ben @@ -1596,10 +1637,10 @@ 1) Create an lcrecord-list object using make_lcrecord_list(). This is often done at initialization. Remember to staticpro_nodump() this object! The arguments to make_lcrecord_list() are the same as would be - passed to BASIC_ALLOC_LCRECORD(). + passed to ALLOC_SIZED_LISP_OBJECT(). - 2) Instead of calling BASIC_ALLOC_LCRECORD(), call alloc_managed_lcrecord() - and pass the lcrecord-list earlier created. + 2) Instead of calling ALLOC_SIZED_LISP_OBJECT(), call + alloc_managed_lcrecord() and pass the lcrecord-list earlier created. 3) When done with the lcrecord, call free_managed_lcrecord(). The standard freeing caveats apply: ** make sure there are no pointers to @@ -1609,7 +1650,7 @@ lcrecord goodbye as if it were garbage-collected. This means: -- the contents of the freed lcrecord are undefined, and the contents of something produced by alloc_managed_lcrecord() - are undefined, just like for BASIC_ALLOC_LCRECORD(). + are undefined, just like for ALLOC_SIZED_LISP_OBJECT(). -- the mark method for the lcrecord's type will *NEVER* be called on freed lcrecords. -- the finalize method for the lcrecord's type will be called @@ -1617,8 +1658,9 @@ */ /* UNMANAGED MODEL: */ -void *old_basic_alloc_lcrecord (Bytecount size, - const struct lrecord_implementation *); +Lisp_Object old_alloc_lcrecord (const struct lrecord_implementation *); +Lisp_Object old_alloc_sized_lcrecord (Bytecount size, + const struct lrecord_implementation *); /* HAND-MANAGED MODEL: */ Lisp_Object make_lcrecord_list (Elemcount size, @@ -1628,12 +1670,12 @@ void free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord); /* AUTO-MANAGED MODEL: */ -MODULE_API void * +MODULE_API Lisp_Object alloc_automanaged_lcrecord (Bytecount size, const struct lrecord_implementation *); -#define old_alloc_lcrecord_type(type, lrecord_implementation) \ - ((type *) alloc_automanaged_lcrecord (sizeof (type), lrecord_implementation)) +#define old_alloc_lcrecord_type(type, imp) \ + ((type *) XPNTR (alloc_automanaged_lcrecord (sizeof (type), imp))) void old_free_lcrecord (Lisp_Object rec); @@ -1657,31 +1699,20 @@ #else /* MC_ALLOC */ -/* How to allocate a lrecord: - - - If the size of the lrecord is fix, say it equals its size of its - struct, then use alloc_lrecord_type. - - - If the size varies, i.e. it is not equal to the size of its - struct, use alloc_lrecord and specify the amount of storage you - need for the object. +Lisp_Object alloc_sized_lrecord (Bytecount size, + const struct lrecord_implementation *imp); +Lisp_Object noseeum_alloc_sized_lrecord (Bytecount size, + const struct lrecord_implementation *); +Lisp_Object alloc_lrecord (const struct lrecord_implementation *imp); - - Some lrecords, which are used totally internally, use the - noseeum-* functions for the reason of debugging. - - - To free a Lisp_Object manually, use free_lrecord. */ - -void *alloc_lrecord (Bytecount size, - const struct lrecord_implementation *); - -#define alloc_lrecord_type(type, lrecord_implementation) \ - ((type *) alloc_lrecord (sizeof (type), lrecord_implementation)) +#define alloc_lrecord_type(type, imp) \ + ((type *) XPNTR (alloc_sized_lrecord (sizeof (type), imp))) void *noseeum_alloc_lrecord (Bytecount size, const struct lrecord_implementation *); -#define noseeum_alloc_lrecord_type(type, lrecord_implementation) \ - ((type *) noseeum_alloc_lrecord (sizeof (type), lrecord_implementation)) +#define noseeum_alloc_lrecord_type(type, imp) \ + ((type *) XPNTR (noseeum_alloc_sized_lrecord (sizeof (type), imp))) void free_lrecord (Lisp_Object rec);
--- a/src/lstream.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/lstream.c Sat Dec 26 00:20:27 2009 -0600 @@ -150,12 +150,11 @@ 0, lstream_empty_extra_description_1 }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("stream", lstream, - 0, /*dumpable-flag*/ - mark_lstream, print_lstream, - finalize_lstream, 0, 0, - lstream_description, - sizeof_lstream, Lstream); +DEFINE_NONDUMPABLE_SIZABLE_LISP_OBJECT ("stream", lstream, + mark_lstream, print_lstream, + finalize_lstream, 0, 0, + lstream_description, + sizeof_lstream, Lstream); /* Change the buffering of a stream. See lstream.h. By default the @@ -197,9 +196,8 @@ { Lstream *p; #ifdef MC_ALLOC - p = XLSTREAM (wrap_pointer_1 - (alloc_lrecord (aligned_sizeof_lstream (imp->size), - &lrecord_lstream))); + p = XLSTREAM (alloc_sized_lrecord (aligned_sizeof_lstream (imp->size), + &lrecord_lstream)); #else /* not MC_ALLOC */ int i; @@ -1882,5 +1880,5 @@ void vars_of_lstream (void) { - INIT_LRECORD_IMPLEMENTATION (lstream); + INIT_LISP_OBJECT (lstream); }
--- a/src/marker.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/marker.c Sat Dec 26 00:20:27 2009 -0600 @@ -115,15 +115,13 @@ } } -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, - 1, /*dumpable-flag*/ +DEFINE_BASIC_LISP_OBJECT ("marker", marker, mark_marker, print_marker, finalize_marker, marker_equal, marker_hash, marker_description, Lisp_Marker); #else /* not MC_ALLOC */ -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, - 1, /*dumpable-flag*/ +DEFINE_BASIC_LISP_OBJECT ("marker", marker, mark_marker, print_marker, 0, marker_equal, marker_hash, marker_description, Lisp_Marker); @@ -529,7 +527,7 @@ void syms_of_marker (void) { - INIT_LRECORD_IMPLEMENTATION (marker); + INIT_LISP_OBJECT (marker); DEFSUBR (Fmarker_position); DEFSUBR (Fmarker_buffer);
--- a/src/mule-charset.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/mule-charset.c Sat Dec 26 00:20:27 2009 -0600 @@ -179,9 +179,8 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("charset", charset, - 1, /* dumpable flag */ - mark_charset, print_charset, 0, +DEFINE_LISP_OBJECT ("charset", charset, + mark_charset, print_charset, 0, 0, 0, charset_description, Lisp_Charset); /* Make a new charset. */ /* #### SJT Should generic properties be allowed? */ @@ -197,8 +196,8 @@ if (!overwrite) { - cs = ALLOC_LCRECORD_TYPE (Lisp_Charset, &lrecord_charset); - obj = wrap_charset (cs); + obj = ALLOC_LISP_OBJECT (charset); + cs = XCHARSET (obj); if (final) { @@ -933,7 +932,7 @@ void syms_of_mule_charset (void) { - INIT_LRECORD_IMPLEMENTATION (charset); + INIT_LISP_OBJECT (charset); DEFSUBR (Fcharsetp); DEFSUBR (Ffind_charset);
--- a/src/number.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/number.c Sat Dec 26 00:20:27 2009 -0600 @@ -106,7 +106,7 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bignum", bignum, 1, 0, bignum_print, +DEFINE_BASIC_LISP_OBJECT ("bignum", bignum, 0, bignum_print, 0, bignum_equal, bignum_hash, bignum_description, Lisp_Bignum); @@ -183,9 +183,9 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("ratio", ratio, 0, 0, ratio_print, - 0, ratio_equal, ratio_hash, - ratio_description, Lisp_Ratio); +DEFINE_NONDUMPABLE_BASIC_LISP_OBJECT ("ratio", ratio, 0, ratio_print, + 0, ratio_equal, ratio_hash, + ratio_description, Lisp_Ratio); #endif /* HAVE_RATIO */ @@ -270,7 +270,7 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bigfloat", bigfloat, 1, 0, +DEFINE_BASIC_LISP_OBJECT ("bigfloat", bigfloat, 0, bigfloat_print, 0, bigfloat_equal, bigfloat_hash, bigfloat_description, Lisp_Bigfloat); @@ -743,13 +743,13 @@ syms_of_number (void) { #ifdef HAVE_BIGNUM - INIT_LRECORD_IMPLEMENTATION (bignum); + INIT_LISP_OBJECT (bignum); #endif #ifdef HAVE_RATIO - INIT_LRECORD_IMPLEMENTATION (ratio); + INIT_LISP_OBJECT (ratio); #endif #ifdef HAVE_BIGFLOAT - INIT_LRECORD_IMPLEMENTATION (bigfloat); + INIT_LISP_OBJECT (bigfloat); #endif /* Type predicates */
--- a/src/objects.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/objects.c Sat Dec 26 00:20:27 2009 -0600 @@ -145,13 +145,12 @@ LISP_HASH (obj))); } -DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance, - 0, /*dumpable-flag*/ - mark_color_instance, print_color_instance, - finalize_color_instance, color_instance_equal, - color_instance_hash, - color_instance_description, - Lisp_Color_Instance); +DEFINE_NONDUMPABLE_LISP_OBJECT ("color-instance", color_instance, + mark_color_instance, print_color_instance, + finalize_color_instance, color_instance_equal, + color_instance_hash, + color_instance_description, + Lisp_Color_Instance); DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /* Return a new `color-instance' object named NAME (a string). @@ -172,13 +171,15 @@ */ (name, device, noerror)) { + Lisp_Object obj; Lisp_Color_Instance *c; int retval; CHECK_STRING (name); device = wrap_device (decode_device (device)); - c = ALLOC_LCRECORD_TYPE (Lisp_Color_Instance, &lrecord_color_instance); + obj = ALLOC_LISP_OBJECT (color_instance); + c = XCOLOR_INSTANCE (obj); c->name = name; c->device = device; c->data = 0; @@ -190,7 +191,7 @@ if (!retval) return Qnil; - return wrap_color_instance (c); + return obj; } DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /* @@ -354,12 +355,11 @@ depth + 1); } -DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance, - 0, /*dumpable-flag*/ - mark_font_instance, print_font_instance, - finalize_font_instance, font_instance_equal, - font_instance_hash, font_instance_description, - Lisp_Font_Instance); +DEFINE_NONDUMPABLE_LISP_OBJECT ("font-instance", font_instance, + mark_font_instance, print_font_instance, + finalize_font_instance, font_instance_equal, + font_instance_hash, font_instance_description, + Lisp_Font_Instance); DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /* @@ -376,6 +376,7 @@ */ (name, device, noerror)) { + Lisp_Object obj; Lisp_Font_Instance *f; int retval = 0; Error_Behavior errb = decode_error_behavior_flag (noerror); @@ -387,7 +388,8 @@ device = wrap_device (decode_device (device)); - f = ALLOC_LCRECORD_TYPE (Lisp_Font_Instance, &lrecord_font_instance); + obj = ALLOC_LISP_OBJECT (font_instance); + f = XFONT_INSTANCE (obj); f->name = name; f->truename = Qnil; f->device = device; @@ -407,7 +409,7 @@ if (!retval) return Qnil; - return wrap_font_instance (f); + return obj; } DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /* @@ -1120,8 +1122,8 @@ void syms_of_objects (void) { - INIT_LRECORD_IMPLEMENTATION (color_instance); - INIT_LRECORD_IMPLEMENTATION (font_instance); + INIT_LISP_OBJECT (color_instance); + INIT_LISP_OBJECT (font_instance); DEFSUBR (Fcolor_specifier_p); DEFSUBR (Ffont_specifier_p); @@ -1195,21 +1197,20 @@ void reinit_vars_of_objects (void) { - staticpro_nodump (&Vthe_null_color_instance); { - Lisp_Color_Instance *c = - ALLOC_LCRECORD_TYPE (Lisp_Color_Instance, &lrecord_color_instance); + Lisp_Object obj = ALLOC_LISP_OBJECT (color_instance); + Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); c->name = Qnil; c->device = Qnil; c->data = 0; - Vthe_null_color_instance = wrap_color_instance (c); + Vthe_null_color_instance = obj; + staticpro_nodump (&Vthe_null_color_instance); } - staticpro_nodump (&Vthe_null_font_instance); { - Lisp_Font_Instance *f = - ALLOC_LCRECORD_TYPE (Lisp_Font_Instance, &lrecord_font_instance); + Lisp_Object obj = ALLOC_LISP_OBJECT (font_instance); + Lisp_Font_Instance *f = XFONT_INSTANCE (obj); f->name = Qnil; f->truename = Qnil; f->device = Qnil; @@ -1220,7 +1221,8 @@ f->width = 0; f->proportional_p = 0; - Vthe_null_font_instance = wrap_font_instance (f); + Vthe_null_font_instance = obj; + staticpro_nodump (&Vthe_null_font_instance); } }
--- a/src/opaque.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/opaque.c Sat Dec 26 00:20:27 2009 -0600 @@ -74,8 +74,9 @@ Lisp_Object make_opaque (const void *data, Bytecount size) { - Lisp_Opaque *p = (Lisp_Opaque *) - BASIC_ALLOC_LCRECORD (aligned_sizeof_opaque (size), &lrecord_opaque); + Lisp_Object obj = + ALLOC_SIZED_LISP_OBJECT (aligned_sizeof_opaque (size), opaque); + Lisp_Opaque *p = XOPAQUE (obj); p->size = size; if (data == OPAQUE_CLEAR) @@ -85,9 +86,7 @@ else memcpy (p->data, data, size); - { - return wrap_opaque (p); - } + return obj; } /* This will not work correctly for opaques with subobjects! */ @@ -115,12 +114,11 @@ { XD_END } }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("opaque", opaque, - 1, /*dumpable-flag*/ - 0, print_opaque, 0, - equal_opaque, hash_opaque, - opaque_description, - sizeof_opaque, Lisp_Opaque); +DEFINE_SIZABLE_LISP_OBJECT ("opaque", opaque, + 0, print_opaque, 0, + equal_opaque, hash_opaque, + opaque_description, + sizeof_opaque, Lisp_Opaque); /* stuff to handle opaque pointers */ @@ -153,19 +151,16 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("opaque-ptr", opaque_ptr, - 0, /*dumpable-flag*/ - 0, print_opaque_ptr, 0, - equal_opaque_ptr, hash_opaque_ptr, - opaque_ptr_description, Lisp_Opaque_Ptr); +DEFINE_NONDUMPABLE_LISP_OBJECT ("opaque-ptr", opaque_ptr, + 0, print_opaque_ptr, 0, + equal_opaque_ptr, hash_opaque_ptr, + opaque_ptr_description, Lisp_Opaque_Ptr); Lisp_Object make_opaque_ptr (void *val) { #ifdef MC_ALLOC - Lisp_Object res = - wrap_pointer_1 (alloc_lrecord_type (Lisp_Opaque_Ptr, - &lrecord_opaque_ptr)); + Lisp_Object res = ALLOC_LISP_OBJECT (opaque_ptr); #else /* not MC_ALLOC */ Lisp_Object res = alloc_managed_lcrecord (Vopaque_ptr_free_list); #endif /* not MC_ALLOC */ @@ -199,8 +194,8 @@ void init_opaque_once_early (void) { - INIT_LRECORD_IMPLEMENTATION (opaque); - INIT_LRECORD_IMPLEMENTATION (opaque_ptr); + INIT_LISP_OBJECT (opaque); + INIT_LISP_OBJECT (opaque_ptr); #ifndef MC_ALLOC reinit_opaque_early ();
--- a/src/print.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/print.c Sat Dec 26 00:20:27 2009 -0600 @@ -1449,9 +1449,9 @@ UNGCPRO; } -static void -default_object_printer (Lisp_Object obj, Lisp_Object printcharfun, - int UNUSED (escapeflag)) +void +external_object_printer (Lisp_Object obj, Lisp_Object printcharfun, + int UNUSED (escapeflag)) { struct LCRECORD_HEADER *header = (struct LCRECORD_HEADER *) XPNTR (obj); @@ -1474,10 +1474,16 @@ header->uid); } -void +static void internal_object_printer (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag)) { + if (print_readably) + printing_unreadable_object + ("#<INTERNAL OBJECT (XEmacs bug?) (%s) 0x%lx>", + XRECORD_LHEADER_IMPLEMENTATION (obj)->name, + (unsigned long) XPNTR (obj)) + write_fmt_string (printcharfun, "#<INTERNAL OBJECT (XEmacs bug?) (%s) 0x%lx>", XRECORD_LHEADER_IMPLEMENTATION (obj)->name, @@ -1749,7 +1755,7 @@ ((LHEADER_IMPLEMENTATION (lheader)->printer) (obj, printcharfun, escapeflag)); else - default_object_printer (obj, printcharfun, escapeflag); + internal_object_printer (obj, printcharfun, escapeflag); break; }
--- a/src/process.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/process.c Sat Dec 26 00:20:27 2009 -0600 @@ -209,10 +209,9 @@ } } -DEFINE_LRECORD_IMPLEMENTATION ("process", process, - 0, /*dumpable-flag*/ - mark_process, print_process, finalize_process, - 0, 0, process_description, Lisp_Process); +DEFINE_NONDUMPABLE_LISP_OBJECT ("process", process, + mark_process, print_process, finalize_process, + 0, 0, process_description, Lisp_Process); /************************************************************************/ /* basic process accessors */ @@ -481,9 +480,10 @@ Lisp_Object make_process_internal (Lisp_Object name) { - Lisp_Object val, name1; + Lisp_Object name1; int i; - Lisp_Process *p = ALLOC_LCRECORD_TYPE (Lisp_Process, &lrecord_process); + Lisp_Object obj = ALLOC_LISP_OBJECT (process); + Lisp_Process *p = XPROCESS (obj); #define MARKED_SLOT(x) p->x = Qnil; #include "process-slots.h" @@ -508,10 +508,8 @@ MAYBE_PROCMETH (alloc_process_data, (p)); - val = wrap_process (p); - - Vprocess_list = Fcons (val, Vprocess_list); - return val; + Vprocess_list = Fcons (obj, Vprocess_list); + return obj; } void @@ -2501,7 +2499,7 @@ void syms_of_process (void) { - INIT_LRECORD_IMPLEMENTATION (process); + INIT_LISP_OBJECT (process); DEFSYMBOL (Qprocessp); DEFSYMBOL (Qprocess_live_p);
--- a/src/rangetab.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/rangetab.c Sat Dec 26 00:20:27 2009 -0600 @@ -219,9 +219,8 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("range-table", range_table, - 1, /*dumpable-flag*/ - mark_range_table, print_range_table, 0, +DEFINE_LISP_OBJECT ("range-table", range_table, + mark_range_table, print_range_table, 0, range_table_equal, range_table_hash, range_table_description, Lisp_Range_Table); @@ -328,11 +327,11 @@ */ (type)) { - Lisp_Range_Table *rt = ALLOC_LCRECORD_TYPE (Lisp_Range_Table, - &lrecord_range_table); + Lisp_Object obj = ALLOC_LISP_OBJECT (range_table); + Lisp_Range_Table *rt = XRANGE_TABLE (obj); rt->entries = Dynarr_new (range_table_entry); rt->type = range_table_symbol_to_type (type); - return wrap_range_table (rt); + return obj; } DEFUN ("copy-range-table", Fcopy_range_table, 1, 1, 0, /* @@ -343,17 +342,19 @@ (range_table)) { Lisp_Range_Table *rt, *rtnew; + Lisp_Object obj; CHECK_RANGE_TABLE (range_table); rt = XRANGE_TABLE (range_table); - rtnew = ALLOC_LCRECORD_TYPE (Lisp_Range_Table, &lrecord_range_table); + obj = ALLOC_LISP_OBJECT (range_table); + rtnew = XRANGE_TABLE (obj); rtnew->entries = Dynarr_new (range_table_entry); rtnew->type = rt->type; Dynarr_add_many (rtnew->entries, Dynarr_atp (rt->entries, 0), Dynarr_length (rt->entries)); - return wrap_range_table (rtnew); + return obj; } DEFUN ("get-range-table", Fget_range_table, 2, 3, 0, /* @@ -879,7 +880,7 @@ void syms_of_rangetab (void) { - INIT_LRECORD_IMPLEMENTATION (range_table); + INIT_LISP_OBJECT (range_table); DEFSYMBOL_MULTIWORD_PREDICATE (Qrange_tablep); DEFSYMBOL (Qrange_table);
--- a/src/scrollbar.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/scrollbar.c Sat Dec 26 00:20:27 2009 -0600 @@ -96,12 +96,11 @@ return Qnil; } -DEFINE_LRECORD_IMPLEMENTATION ("scrollbar-instance", scrollbar_instance, - 0, /*dumpable-flag*/ - mark_scrollbar_instance, - internal_object_printer, 0, 0, 0, - scrollbar_instance_description, - struct scrollbar_instance); +DEFINE_NONDUMPABLE_LISP_OBJECT ("scrollbar-instance", scrollbar_instance, + mark_scrollbar_instance, + 0, 0, 0, 0, + scrollbar_instance_description, + struct scrollbar_instance); static void free_scrollbar_instance (struct scrollbar_instance *instance, @@ -198,9 +197,8 @@ create_scrollbar_instance (struct frame *f, int vertical) { struct device *d = XDEVICE (f->device); - struct scrollbar_instance *instance = - ALLOC_LCRECORD_TYPE (struct scrollbar_instance, - &lrecord_scrollbar_instance); + Lisp_Object obj = ALLOC_LISP_OBJECT (scrollbar_instance); + struct scrollbar_instance *instance = XSCROLLBAR_INSTANCE (obj); MAYBE_DEVMETH (d, create_scrollbar_instance, (f, vertical, instance)); @@ -928,7 +926,7 @@ void syms_of_scrollbar (void) { - INIT_LRECORD_IMPLEMENTATION (scrollbar_instance); + INIT_LISP_OBJECT (scrollbar_instance); DEFSYMBOL (Qscrollbar_line_up); DEFSYMBOL (Qscrollbar_line_down);
--- a/src/specifier.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/specifier.c Sat Dec 26 00:20:27 2009 -0600 @@ -421,14 +421,13 @@ 0, specifier_empty_extra_description_1 }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("specifier", specifier, - 1, /*dumpable-flag*/ - mark_specifier, print_specifier, - finalize_specifier, - specifier_equal, specifier_hash, - specifier_description, - sizeof_specifier, - Lisp_Specifier); +DEFINE_SIZABLE_LISP_OBJECT ("specifier", specifier, + mark_specifier, print_specifier, + finalize_specifier, + specifier_equal, specifier_hash, + specifier_description, + sizeof_specifier, + Lisp_Specifier); /************************************************************************/ /* Creating specifiers */ @@ -491,10 +490,9 @@ make_specifier_internal (struct specifier_methods *spec_meths, Bytecount data_size, int call_create_meth) { - Lisp_Object specifier; - Lisp_Specifier *sp = (Lisp_Specifier *) - BASIC_ALLOC_LCRECORD (aligned_sizeof_specifier (data_size), - &lrecord_specifier); + Lisp_Object specifier = + ALLOC_SIZED_LISP_OBJECT (aligned_sizeof_specifier (data_size), specifier); + Lisp_Specifier *sp = XSPECIFIER (specifier); sp->methods = spec_meths; sp->global_specs = Qnil; @@ -507,7 +505,6 @@ sp->caching = 0; sp->next_specifier = Vall_specifiers; - specifier = wrap_specifier (sp); Vall_specifiers = specifier; if (call_create_meth) @@ -3348,7 +3345,7 @@ void syms_of_specifier (void) { - INIT_LRECORD_IMPLEMENTATION (specifier); + INIT_LISP_OBJECT (specifier); DEFSYMBOL (Qspecifierp);
--- a/src/symbols.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/symbols.c Sat Dec 26 00:20:27 2009 -0600 @@ -136,8 +136,7 @@ return external_remprop (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME); } -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("symbol", symbol, - 1, /*dumpable-flag*/ +DEFINE_BASIC_LISP_OBJECT_WITH_PROPS ("symbol", symbol, mark_symbol, print_symbol, 0, 0, 0, symbol_description, symbol_getprop, @@ -1009,33 +1008,29 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward", +DEFINE_LISP_OBJECT ("symbol-value-forward", symbol_value_forward, - 1, /*dumpable-flag*/ 0, print_symbol_value_magic, 0, 0, 0, symbol_value_forward_description, struct symbol_value_forward); -DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local", +DEFINE_LISP_OBJECT ("symbol-value-buffer-local", symbol_value_buffer_local, - 1, /*dumpable-flag*/ mark_symbol_value_buffer_local, print_symbol_value_magic, 0, 0, 0, symbol_value_buffer_local_description, struct symbol_value_buffer_local); -DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic", +DEFINE_LISP_OBJECT ("symbol-value-lisp-magic", symbol_value_lisp_magic, - 1, /*dumpable-flag*/ mark_symbol_value_lisp_magic, print_symbol_value_magic, 0, 0, 0, symbol_value_lisp_magic_description, struct symbol_value_lisp_magic); -DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias", +DEFINE_LISP_OBJECT ("symbol-value-varalias", symbol_value_varalias, - 1, /*dumpable-flag*/ mark_symbol_value_varalias, print_symbol_value_magic, 0, 0, 0, symbol_value_varalias_description, @@ -2187,8 +2182,8 @@ { struct symbol_value_buffer_local *bfwd - = ALLOC_LCRECORD_TYPE (struct symbol_value_buffer_local, - &lrecord_symbol_value_buffer_local); + = XSYMBOL_VALUE_BUFFER_LOCAL + (ALLOC_LISP_OBJECT (symbol_value_buffer_local)); Lisp_Object foo; bfwd->magic.type = SYMVAL_BUFFER_LOCAL; @@ -2295,8 +2290,8 @@ } /* Make sure variable is set up to hold per-buffer values */ - bfwd = ALLOC_LCRECORD_TYPE (struct symbol_value_buffer_local, - &lrecord_symbol_value_buffer_local); + bfwd = XSYMBOL_VALUE_BUFFER_LOCAL + (ALLOC_LISP_OBJECT (symbol_value_buffer_local)); bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL; bfwd->current_buffer = Qnil; @@ -3015,8 +3010,9 @@ valcontents = XSYMBOL (variable)->value; if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents)) { - bfwd = ALLOC_LCRECORD_TYPE (struct symbol_value_lisp_magic, - &lrecord_symbol_value_lisp_magic); + bfwd = + XSYMBOL_VALUE_LISP_MAGIC + (ALLOC_LISP_OBJECT (symbol_value_lisp_magic)); bfwd->magic.type = SYMVAL_LISP_MAGIC; for (i = 0; i < MAGIC_HANDLER_MAX; i++) { @@ -3151,8 +3147,8 @@ invalid_change ("Variable is magic and cannot be aliased", variable); reject_constant_symbols (variable, Qunbound, 0, Qt); - bfwd = ALLOC_LCRECORD_TYPE (struct symbol_value_varalias, - &lrecord_symbol_value_varalias); + bfwd = + XSYMBOL_VALUE_VARALIAS (ALLOC_LISP_OBJECT (symbol_value_varalias)); bfwd->magic.type = SYMVAL_VARALIAS; bfwd->aliasee = alias; bfwd->shadowed = valcontents; @@ -3275,11 +3271,11 @@ void init_symbols_once_early (void) { - INIT_LRECORD_IMPLEMENTATION (symbol); - INIT_LRECORD_IMPLEMENTATION (symbol_value_forward); - INIT_LRECORD_IMPLEMENTATION (symbol_value_buffer_local); - INIT_LRECORD_IMPLEMENTATION (symbol_value_lisp_magic); - INIT_LRECORD_IMPLEMENTATION (symbol_value_varalias); + INIT_LISP_OBJECT (symbol); + INIT_LISP_OBJECT (symbol_value_forward); + INIT_LISP_OBJECT (symbol_value_buffer_local); + INIT_LISP_OBJECT (symbol_value_lisp_magic); + INIT_LISP_OBJECT (symbol_value_varalias); reinit_symbols_early ();
--- a/src/toolbar.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/toolbar.c Sat Dec 26 00:20:27 2009 -0600 @@ -88,11 +88,10 @@ return data->help_string; } -DEFINE_LRECORD_IMPLEMENTATION ("toolbar-button", toolbar_button, - 0, /*dumpable-flag*/ - mark_toolbar_button, 0, 0, 0, 0, - toolbar_button_description, - struct toolbar_button); +DEFINE_NONDUMPABLE_LISP_OBJECT ("toolbar-button", toolbar_button, + mark_toolbar_button, 0, 0, 0, 0, + toolbar_button_description, + struct toolbar_button); DEFUN ("toolbar-button-p", Ftoolbar_button_p, 1, 1, 0, /* Return non-nil if OBJECT is a toolbar button. @@ -303,7 +302,7 @@ if (!tb) { - tb = ALLOC_LCRECORD_TYPE (struct toolbar_button, &lrecord_toolbar_button); + tb = XTOOLBAR_BUTTON (ALLOC_LISP_OBJECT (toolbar_button)); tb->next = Qnil; tb->frame = wrap_frame (f); tb->up_glyph = Qnil; @@ -1336,7 +1335,7 @@ void syms_of_toolbar (void) { - INIT_LRECORD_IMPLEMENTATION (toolbar_button); + INIT_LISP_OBJECT (toolbar_button); DEFSYMBOL_MULTIWORD_PREDICATE (Qtoolbar_buttonp); DEFSYMBOL (Q2D);
--- a/src/tooltalk.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/tooltalk.c Sat Dec 26 00:20:27 2009 -0600 @@ -179,24 +179,22 @@ (long) (p->m), p->header.uid); } -DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-message", tooltalk_message, - 0, /*dumpable-flag*/ - mark_tooltalk_message, print_tooltalk_message, - 0, 0, 0, - tooltalk_message_description, - Lisp_Tooltalk_Message); +DEFINE_NONDUMPABLE_LISP_OBJECT ("tooltalk-message", tooltalk_message, + mark_tooltalk_message, print_tooltalk_message, + 0, 0, 0, + tooltalk_message_description, + Lisp_Tooltalk_Message); static Lisp_Object make_tooltalk_message (Tt_message m) { - Lisp_Object val; - Lisp_Tooltalk_Message *msg = - ALLOC_LCRECORD_TYPE (Lisp_Tooltalk_Message, &lrecord_tooltalk_message); + Lisp_Object obj = ALLOC_LISP_OBJECT (tooltalk_message); + Lisp_Tooltalk_Message *msg = XTOOLTALK_MESSAGE (obj); msg->m = m; msg->callback = Qnil; msg->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str); - return wrap_tooltalk_message (msg); + return obj; } Tt_message @@ -257,25 +255,23 @@ (long) (p->p), p->header.uid); } -DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern, - 0, /*dumpable-flag*/ - mark_tooltalk_pattern, print_tooltalk_pattern, - 0, 0, 0, - tooltalk_pattern_description, - Lisp_Tooltalk_Pattern); +DEFINE_NONDUMPABLE_LISP_OBJECT ("tooltalk-pattern", tooltalk_pattern, + mark_tooltalk_pattern, print_tooltalk_pattern, + 0, 0, 0, + tooltalk_pattern_description, + Lisp_Tooltalk_Pattern); static Lisp_Object make_tooltalk_pattern (Tt_pattern p) { - Lisp_Tooltalk_Pattern *pat = - ALLOC_LCRECORD_TYPE (Lisp_Tooltalk_Pattern, &lrecord_tooltalk_pattern); - Lisp_Object val; + Lisp_Object obj = ALLOC_LISP_OBJECT (tooltalk_pattern); + Lisp_Tooltalk_Pattern *pat = XTOOLTALK_PATTERN (obj); pat->p = p; pat->callback = Qnil; pat->plist_sym = Fmake_symbol (Tooltalk_Pattern_plist_str); - return wrap_tooltalk_pattern (pat); + return obj; } static Tt_pattern @@ -1317,8 +1313,8 @@ void syms_of_tooltalk (void) { - INIT_LRECORD_IMPLEMENTATION (tooltalk_message); - INIT_LRECORD_IMPLEMENTATION (tooltalk_pattern); + INIT_LISP_OBJECT (tooltalk_message); + INIT_LISP_OBJECT (tooltalk_pattern); DEFSYMBOL_MULTIWORD_PREDICATE (Qtooltalk_messagep); DEFSUBR (Ftooltalk_message_p);
--- a/src/ui-gtk.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/ui-gtk.c Sat Dec 26 00:20:27 2009 -0600 @@ -280,7 +280,8 @@ static emacs_ffi_data * allocate_ffi_data (void) { - emacs_ffi_data *data = ALLOC_LCRECORD_TYPE (emacs_ffi_data, &lrecord_emacs_ffi); + Lisp_Object obj = ALLOC_LISP_OBJECT (emacs_ffi); + emacs_ffi_data *data = XFFI (obj); data->return_type = GTK_TYPE_NONE; data->n_args = 0; @@ -318,11 +319,10 @@ write_fmt_string (printcharfun, " %p>", (void *)XFFI (obj)->function_ptr); } -DEFINE_LRECORD_IMPLEMENTATION ("ffi", emacs_ffi, - 0, /*dumpable-flag*/ - mark_ffi_data, ffi_object_printer, - 0, 0, 0, - ffi_data_description, emacs_ffi_data); +DEFINE_NONDUMPABLE_LISP_OBJECT ("ffi", emacs_ffi, + mark_ffi_data, ffi_object_printer, + 0, 0, 0, + ffi_data_description, emacs_ffi_data); #if defined (__cplusplus) #define MANY_ARGS ... @@ -927,25 +927,24 @@ } } -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("GtkObject", emacs_gtk_object, - 0, /*dumpable-flag*/ - mark_gtk_object_data, - emacs_gtk_object_printer, - emacs_gtk_object_finalizer, - 0, /* equality */ - 0, /* hash */ - gtk_object_data_description, - object_getprop, - object_putprop, - 0, /* rem prop */ - 0, /* plist */ - emacs_gtk_object_data); +DEFINE_NONDUMPABLE_LISP_OBJECT_WITH_PROPS ("GtkObject", emacs_gtk_object, + mark_gtk_object_data, + emacs_gtk_object_printer, + emacs_gtk_object_finalizer, + 0, /* equality */ + 0, /* hash */ + gtk_object_data_description, + object_getprop, + object_putprop, + 0, /* rem prop */ + 0, /* plist */ + emacs_gtk_object_data); static emacs_gtk_object_data * allocate_emacs_gtk_object_data (void) { - emacs_gtk_object_data *data = ALLOC_LCRECORD_TYPE (emacs_gtk_object_data, - &lrecord_emacs_gtk_object); + Lisp_Object obj = ALLOC_LISP_OBJECT (emacs_gtk_object); + emacs_gtk_object_data *data = XGTK_OBJECT (obj); data->object = NULL; data->alive_p = FALSE; @@ -1123,19 +1122,18 @@ return (HASH2 ((Hashcode) data->object, data->object_type)); } -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("GtkBoxed", emacs_gtk_boxed, - 0, /*dumpable-flag*/ - 0, /* marker function */ - emacs_gtk_boxed_printer, - 0, /* nuker */ - emacs_gtk_boxed_equality, - emacs_gtk_boxed_hash, - emacs_gtk_boxed_description, - 0, /* get prop */ - 0, /* put prop */ - 0, /* rem prop */ - 0, /* plist */ - emacs_gtk_boxed_data); +DEFINE_NONDUMPABLE_LISP_OBJECT_WITH_PROPS ("GtkBoxed", emacs_gtk_boxed, + 0, /* marker function */ + emacs_gtk_boxed_printer, + 0, /* nuker */ + emacs_gtk_boxed_equality, + emacs_gtk_boxed_hash, + emacs_gtk_boxed_description, + 0, /* get prop */ + 0, /* put prop */ + 0, /* rem prop */ + 0, /* plist */ + emacs_gtk_boxed_data); /* Currently defined GTK_TYPE_BOXED structures are: GtkAccelGroup - @@ -1153,8 +1151,8 @@ static emacs_gtk_boxed_data * allocate_emacs_gtk_boxed_data (void) { - emacs_gtk_boxed_data *data = ALLOC_LCRECORD_TYPE (emacs_gtk_boxed_data, - &lrecord_emacs_gtk_boxed); + Lisp_Object obj = ALLOC_LISP_OBJECT (emacs_gtk_boxed); + emacs_gtk_boxed_data *data = XGTK_BOXED (obj); data->object = NULL; data->object_type = GTK_TYPE_INVALID; @@ -1340,9 +1338,9 @@ void syms_of_ui_gtk (void) { - INIT_LRECORD_IMPLEMENTATION (emacs_ffi); - INIT_LRECORD_IMPLEMENTATION (emacs_gtk_object); - INIT_LRECORD_IMPLEMENTATION (emacs_gtk_boxed); + INIT_LISP_OBJECT (emacs_ffi); + INIT_LISP_OBJECT (emacs_gtk_object); + INIT_LISP_OBJECT (emacs_gtk_boxed); DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_ffip); DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_gtk_objectp); DEFSYMBOL_MULTIWORD_PREDICATE (Qemacs_gtk_boxedp);
--- a/src/window.c Sat Dec 26 00:20:16 2009 -0600 +++ b/src/window.c Sat Dec 26 00:20:27 2009 -0600 @@ -324,10 +324,9 @@ return make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ); } -DEFINE_LRECORD_IMPLEMENTATION ("window", window, - 0, /*dumpable-flag*/ - mark_window, print_window, finalize_window, - 0, 0, window_description, struct window); +DEFINE_NONDUMPABLE_LISP_OBJECT ("window", window, + mark_window, print_window, finalize_window, + 0, 0, window_description, struct window); #define INIT_DISP_VARIABLE(field, initialization) \ p->field[CURRENT_DISP] = initialization; \ @@ -346,8 +345,8 @@ Lisp_Object allocate_window (void) { - struct window *p = ALLOC_LCRECORD_TYPE (struct window, &lrecord_window); - Lisp_Object val = wrap_window (p); + Lisp_Object obj = ALLOC_LISP_OBJECT (window); + struct window *p = XWINDOW (obj); #define WINDOW_SLOT(slot) p->slot = Qnil; #include "winslots.h" @@ -372,7 +371,7 @@ p->windows_changed = 1; p->shadow_thickness_changed = 1; - return val; + return obj; } #undef INIT_DISP_VARIABLE @@ -471,19 +470,18 @@ return Qnil; } -DEFINE_LRECORD_IMPLEMENTATION ("window-mirror", window_mirror, - 0, /*dumpable-flag*/ - mark_window_mirror, internal_object_printer, - 0, 0, 0, window_mirror_description, - struct window_mirror); +DEFINE_NONDUMPABLE_LISP_OBJECT ("window-mirror", window_mirror, + mark_window_mirror, 0, + 0, 0, 0, window_mirror_description, + struct window_mirror); /* Create a new window mirror structure and associated redisplay structs. */ static struct window_mirror * new_window_mirror (struct frame *f) { - struct window_mirror *t = - ALLOC_LCRECORD_TYPE (struct window_mirror, &lrecord_window_mirror); + Lisp_Object obj = ALLOC_LISP_OBJECT (window_mirror); + struct window_mirror *t = XWINDOW_MIRROR (obj); t->frame = f; t->current_display_lines = Dynarr_new (display_line); @@ -3800,11 +3798,10 @@ static void make_dummy_parent (Lisp_Object window) { - Lisp_Object new_; struct window *o = XWINDOW (window); - struct window *p = ALLOC_LCRECORD_TYPE (struct window, &lrecord_window); - - new_ = wrap_window (p); + Lisp_Object obj = ALLOC_LISP_OBJECT (window); + struct window *p = XWINDOW (obj); + COPY_LCRECORD (p, o); /* Don't copy the pointers to the line start cache or the face @@ -3816,13 +3813,13 @@ make_image_instance_cache_hash_table (); /* Put new into window structure in place of window */ - replace_window (window, new_); + replace_window (window, obj); o->next = Qnil; o->prev = Qnil; o->vchild = Qnil; o->hchild = Qnil; - o->parent = new_; + o->parent = obj; p->start[CURRENT_DISP] = Qnil; p->start[DESIRED_DISP] = Qnil; @@ -5382,8 +5379,8 @@ void syms_of_window (void) { - INIT_LRECORD_IMPLEMENTATION (window); - INIT_LRECORD_IMPLEMENTATION (window_mirror); + INIT_LISP_OBJECT (window); + INIT_LISP_OBJECT (window_mirror); DEFSYMBOL (Qwindowp); DEFSYMBOL (Qwindow_live_p);