Mercurial > hg > xemacs-beta
changeset 5126:2a462149bd6a ben-lisp-object
merge
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Wed, 24 Feb 2010 19:04:27 -0600 |
| parents | b5df3737028a (diff) 78a3c171a427 (current diff) |
| children | a9c41067dd88 |
| files | lisp/ChangeLog src/ChangeLog src/alloc.c src/buffer.c src/console-msw-impl.h src/console.c src/device-tty.c src/device-x.c src/dynarr.c src/emacs.c src/eval.c src/event-stream.c src/events.c src/extents.c src/faces.c src/faces.h src/file-coding.c src/fns.c src/frame-gtk.c src/frame-impl.h src/frame-msw.c src/frame-x.c src/frame.c src/frame.h src/glyphs.c src/keymap.c src/lisp.h src/lrecord.h src/lstream.c src/objects-tty.c src/syntax.c src/toolbar.c src/window.c src/window.h tests/automated/test-harness.el |
| diffstat | 113 files changed, 1922 insertions(+), 1746 deletions(-) [+] |
line wrap: on
line diff
--- a/.hgtags Wed Feb 24 11:08:30 2010 +0100 +++ b/.hgtags Wed Feb 24 19:04:27 2010 -0600 @@ -235,5 +235,7 @@ 223736d75acb5265cfd9352497e8483d787d8eab r21-2-45 0784d089fdc93fb58040b6efbec55cd4fdf650c2 r21-2-46 5aa1854ad5374fa936e99e22e7b1242097292f16 r21-2-47 +aaf96f4ba61234a5331b280b774d357503cd7994 ben-lisp-object-bp 1af222c7586991f690ea06d1b8c75fb5a6a0a352 r21-5-28 5c427ece884b7023a244fba8cad8cf41b37dd5ca r21-5-29 +3742ea8250b5fd339d6d797835faf8761f61d0ae ben-lisp-object-final-ws-year-2005
--- a/lisp/disp-table.el Wed Feb 24 11:08:30 2010 +0100 +++ b/lisp/disp-table.el Wed Feb 24 19:04:27 2010 -0600 @@ -2,8 +2,8 @@ ;; Copyright (C) 1987, 1994, 1997, 2007 Free Software Foundation, Inc. ;; Copyright (C) 1995 Sun Microsystems. +;; Copyright (C) 2005 Ben Wing. -;; Author: Howard Gayle ;; Maintainer: XEmacs Development Team ;; Keywords: i18n, internal @@ -29,7 +29,10 @@ ;;; Commentary: ;; Rewritten for XEmacs July 1995, Ben Wing. - +;; November 1998?, display tables generalized to char/range tables, Hrvoje +;; Niksic. +;; July 2007, rewrite this file to handle generalized display tables, +;; Aidan Kehoe. ;;; Code: @@ -116,6 +119,9 @@ ;; Let me say one more time how much dynamic scoping sucks. +;; #### Need more thinking about basic primitives for modifying a specifier. +;; cf `modify-specifier-instances'. + ;;;###autoload (defun frob-display-table (fdt-function fdt-locale &optional tag-set) (or fdt-locale (setq fdt-locale 'global)) @@ -184,8 +190,8 @@ ;;;###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) (put-char-table c (concat "\016" (char-to-string sc) "\017") x)) @@ -194,8 +200,7 @@ ;;;###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) (put-char-table c (concat "\e(0" (char-to-string gc) "\e(B") x))
--- a/modules/ldap/eldap.c Wed Feb 24 11:08:30 2010 +0100 +++ b/modules/ldap/eldap.c Wed Feb 24 19:04:27 2010 -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, 2010 Ben Wing. This file is part of XEmacs. @@ -141,7 +141,7 @@ static Lisp_LDAP * allocate_ldap (void) { - Lisp_LDAP *ldap = ALLOC_LCRECORD_TYPE (Lisp_LDAP, &lrecord_ldap); + Lisp_LDAP *ldap = XLDAP (ALLOC_LISP_OBJECT (ldap)); ldap->ld = NULL; ldap->host = Qnil; @@ -149,23 +149,19 @@ } static void -finalize_ldap (void *header, int for_disksave) +finalize_ldap (void *header) { Lisp_LDAP *ldap = (Lisp_LDAP *) header; - if (for_disksave) - invalid_operation ("Can't dump an emacs containing LDAP objects", - make_ldap (ldap)); - if (ldap->ld) ldap_unbind (ldap->ld); ldap->ld = NULL; } -DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap, 0, - mark_ldap, print_ldap, finalize_ldap, - NULL, NULL, ldap_description, Lisp_LDAP); - +DEFINE_NODUMP_LISP_OBJECT ("ldap", ldap, mark_ldap, + print_ldap, finalize_ldap, + NULL, NULL, ldap_description, + Lisp_LDAP); /************************************************************************/ /* Basic ldap accessors */ @@ -616,7 +612,6 @@ int rc; int i, j; Elemcount len; - Lisp_Object values = Qnil; struct gcpro gcpro1; @@ -715,7 +710,6 @@ int i, j, rc; Lisp_Object mod_op; Elemcount len; - Lisp_Object values = Qnil; struct gcpro gcpro1; @@ -816,7 +810,7 @@ void syms_of_eldap (void) { - INIT_LRECORD_IMPLEMENTATION (ldap); + INIT_LISP_OBJECT (ldap); DEFSYMBOL (Qeldap); DEFSYMBOL (Qldapp); @@ -878,7 +872,7 @@ unload_eldap (void) { /* Remove defined types */ - UNDEF_LRECORD_IMPLEMENTATION (ldap); + UNDEF_LISP_OBJECT (ldap); /* Remove staticpro'ing of symbols */ unstaticpro_nodump (&Qeldap);
--- a/modules/ldap/eldap.h Wed Feb 24 11:08:30 2010 +0100 +++ b/modules/ldap/eldap.h Wed Feb 24 19:04:27 2010 -0600 @@ -38,7 +38,7 @@ struct Lisp_LDAP { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; /* The LDAP connection handle used by the LDAP API */ LDAP *ld; /* Name of the host we connected to */ @@ -47,7 +47,7 @@ typedef struct Lisp_LDAP Lisp_LDAP; -DECLARE_LRECORD (ldap, Lisp_LDAP); +DECLARE_LISP_OBJECT (ldap, Lisp_LDAP); #define XLDAP(x) XRECORD (x, ldap, Lisp_LDAP) #define wrap_ldap(p) wrap_record (p, ldap) #define LDAPP(x) RECORDP (x, ldap)
--- a/modules/postgresql/postgresql.c Wed Feb 24 11:08:30 2010 +0100 +++ b/modules/postgresql/postgresql.c Wed Feb 24 19:04:27 2010 -0600 @@ -90,8 +90,10 @@ interface to lcrecord handling has changed with 21.2, so unfortunately we will need a few snippets of backwards compatibility code. */ -#if (EMACS_MAJOR_VERSION == 21) && (EMACS_MINOR_VERSION < 2) +#if (EMACS_MAJOR_VERSION == 21) && (EMACS_MINOR_VERSION <= 1) #define RUNNING_XEMACS_21_1 1 +#elif (EMACS_MAJOR_VERSION == 21) && (EMACS_MINOR_VERSION <= 4) +#define RUNNING_XEMACS_21_4 1 #endif /* #define POSTGRES_LO_IMPORT_IS_VOID 1 */ @@ -262,14 +264,18 @@ #ifdef RUNNING_XEMACS_21_1 Lisp_PGconn *pgconn = ALLOC_LCRECORD_TYPE (Lisp_PGconn, lrecord_pgconn); -#else +#elif defined (RUNNING_XEMACS_21_4) Lisp_PGconn *pgconn = ALLOC_LCRECORD_TYPE (Lisp_PGconn, &lrecord_pgconn); +#else + Lisp_PGconn *pgconn = XPGCONN (ALLOC_LISP_OBJECT (pgconn)); #endif pgconn->pgconn = (PGconn *)NULL; return pgconn; } +#ifdef RUNNING_XEMACS_21_4 + static void finalize_pgconn (void *header, int for_disksave) { @@ -286,18 +292,41 @@ } } +#else /* not RUNNING_XEMACS_21_4 */ + +static void +finalize_pgconn (void *header) +{ + Lisp_PGconn *pgconn = (Lisp_PGconn *)header; + + if (pgconn->pgconn) + { + PQfinish (pgconn->pgconn); + pgconn->pgconn = (PGconn *)NULL; + } +} + +#endif /* (not) RUNNING_XEMACS_21_4 */ + #ifdef RUNNING_XEMACS_21_1 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn, mark_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_NODUMP_LISP_OBJECT ("pgconn", pgconn, + mark_pgconn, print_pgconn, + finalize_pgconn, + NULL, NULL, + pgconn_description, + Lisp_PGconn); #endif /****/ @@ -387,14 +416,18 @@ #ifdef RUNNING_XEMACS_21_1 Lisp_PGresult *pgresult = ALLOC_LCRECORD_TYPE (Lisp_PGresult, lrecord_pgresult); -#else +#elif defined (RUNNING_XEMACS_21_4) Lisp_PGresult *pgresult = ALLOC_LCRECORD_TYPE (Lisp_PGresult, &lrecord_pgresult); +#else + Lisp_PGresult *pgresult = XPGRESULT (ALLOC_LISP_OBJECT (pgresult)); #endif pgresult->pgresult = (PGresult *)NULL; return pgresult; } +#ifdef RUNNING_XEMACS_21_4 + static void finalize_pgresult (void *header, int for_disksave) { @@ -411,18 +444,40 @@ } } +#else /* not RUNNING_XEMACS_21_4 */ + +static void +finalize_pgresult (void *header) +{ + Lisp_PGresult *pgresult = (Lisp_PGresult *)header; + + if (pgresult->pgresult) + { + PQclear (pgresult->pgresult); + pgresult->pgresult = (PGresult *)NULL; + } +} + +#endif /* (not) RUNNING_XEMACS_21_4 */ + #ifdef RUNNING_XEMACS_21_1 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult, mark_pgresult, print_pgresult, finalize_pgresult, NULL, NULL, Lisp_PGresult); -#else +#elif defined (RUNNING_XEMACS_21_4) DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult, 0, /*dumpable-flag*/ mark_pgresult, print_pgresult, finalize_pgresult, NULL, NULL, pgresult_description, Lisp_PGresult); +#else +DEFINE_NODUMP_LISP_OBJECT ("pgresult", pgresult, + mark_pgresult, print_pgresult, finalize_pgresult, + NULL, NULL, + pgresult_description, + Lisp_PGresult); #endif /***********************/ @@ -1597,8 +1652,8 @@ syms_of_postgresql(void) { #ifndef RUNNING_XEMACS_21_1 - INIT_LRECORD_IMPLEMENTATION (pgconn); - INIT_LRECORD_IMPLEMENTATION (pgresult); + INIT_LISP_OBJECT (pgconn); + INIT_LISP_OBJECT (pgresult); #endif DEFSYMBOL (Qpostgresql); @@ -1870,8 +1925,8 @@ { #ifndef RUNNING_XEMACS_21_1 /* Remove defined types */ - UNDEF_LRECORD_IMPLEMENTATION (pgconn); - UNDEF_LRECORD_IMPLEMENTATION (pgresult); + UNDEF_LISP_OBJECT (pgconn); + UNDEF_LISP_OBJECT (pgresult); #endif /* Remove staticpro'ing of symbols */
--- a/modules/postgresql/postgresql.h Wed Feb 24 11:08:30 2010 +0100 +++ b/modules/postgresql/postgresql.h Wed Feb 24 19:04:27 2010 -0600 @@ -28,12 +28,12 @@ */ struct Lisp_PGconn { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; PGconn *pgconn; }; typedef struct Lisp_PGconn Lisp_PGconn; -DECLARE_LRECORD (pgconn, Lisp_PGconn); +DECLARE_LISP_OBJECT (pgconn, Lisp_PGconn); #define XPGCONN(x) XRECORD (x, pgconn, Lisp_PGconn) #define wrap_pgconn(p) wrap_record (p, pgconn) @@ -48,12 +48,12 @@ */ struct Lisp_PGresult { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; PGresult *pgresult; }; typedef struct Lisp_PGresult Lisp_PGresult; -DECLARE_LRECORD (pgresult, Lisp_PGresult); +DECLARE_LISP_OBJECT (pgresult, Lisp_PGresult); #define XPGRESULT(x) XRECORD (x, pgresult, Lisp_PGresult) #define wrap_pgresult(p) wrap_record (p, pgresult)
--- a/src/ChangeLog Wed Feb 24 11:08:30 2010 +0100 +++ b/src/ChangeLog Wed Feb 24 19:04:27 2010 -0600 @@ -1,3 +1,237 @@ +2010-01-20 Ben Wing <ben@xemacs.org> + + * alloc.c: + * alloc.c (very_old_free_lcrecord): + * alloc.c (disksave_object_finalization_1): + * alloc.c (make_lcrecord_list): + * alloc.c (alloc_managed_lcrecord): + * alloc.c (free_managed_lcrecord): + * alloc.c (sweep_lcrecords_1): + * buffer.c: + * bytecode.c: + * bytecode.c (Fcompiled_function_p): + * chartab.c: + * console-impl.h: + * console-impl.h (CONSOLE_TYPE_P): + * console.c: + * console.c (set_quit_events): + * data.c: + * data.c (Fmake_ephemeron): + * database.c: + * database.c (finalize_database): + * database.c (Fclose_database): + * device-msw.c: + * device-msw.c (finalize_devmode): + * device-msw.c (allocate_devmode): + * device.c: + * elhash.c: + * elhash.c (finalize_hash_table): + * eval.c: + * eval.c (bind_multiple_value_limits): + * event-stream.c: + * event-stream.c (finalize_command_builder): + * events.c: + * events.c (mark_event): + * extents.c: + * extents.c (finalize_extent_info): + * extents.c (uninit_buffer_extents): + * faces.c: + * file-coding.c: + * file-coding.c (finalize_coding_system): + * file-coding.h: + * file-coding.h (struct coding_system_methods): + * file-coding.h (struct detector): + * floatfns.c: + * floatfns.c (extract_float): + * fns.c: + * fns.c (Fidentity): + * font-mgr.c (finalize_fc_pattern): + * font-mgr.c (finalize_fc_config): + * frame.c: + * glyphs.c: + * glyphs.c (finalize_image_instance): + * glyphs.c (unmap_subwindow_instance_cache_mapper): + * gui.c: + * gui.c (gui_error): + * keymap.c: + * lisp.h (struct Lisp_Symbol): + * lrecord.h: + * lrecord.h (struct lrecord_implementation): + * lrecord.h (MC_ALLOC_CALL_FINALIZER): + * lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE): + * lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT): + * lrecord.h (MAKE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT): + * lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT): + * lrecord.h (MAKE_MODULE_LISP_OBJECT): + * lstream.c: + * lstream.c (finalize_lstream): + * lstream.c (disksave_lstream): + * marker.c: + * marker.c (finalize_marker): + * mule-charset.c (make_charset): + * number.c: + * objects.c: + * objects.c (finalize_color_instance): + * objects.c (finalize_font_instance): + * opaque.c: + * opaque.c (make_opaque_ptr): + * process-nt.c: + * process-nt.c (nt_finalize_process_data): + * process-nt.c (nt_deactivate_process): + * process.c: + * process.c (finalize_process): + * procimpl.h (struct process_methods): + * scrollbar.c: + * scrollbar.c (free_scrollbar_instance): + * specifier.c (finalize_specifier): + * symbols.c: + * toolbar.c: + * toolbar.c (Ftoolbar_button_p): + * tooltalk.c: + * ui-gtk.c: + * ui-gtk.c (emacs_gtk_object_finalizer): + * ui-gtk.c (allocate_emacs_gtk_boxed_data): + * window.c: + * window.c (finalize_window): + * window.c (mark_window_as_deleted): + + Separate out regular and disksave finalization. Instead of a + FOR_DISKSAVE argument to the finalizer, create a separate object + method `disksaver'. Make `finalizer' have only one argument. + + Go through and separate out all finalize methods into finalize + and disksave. Delete lots of thereby redundant disksave checking. + Delete places that signal an error if we attempt to disksave -- + all of these objects are non-dumpable and we will get an error + from pdump anyway if we attempt to dump them. After this is done, + only one object remains that has a disksave method -- lstream. + + Change DEFINE_*_LISP_OBJECT_WITH_PROPS to DEFINE_*_GENERAL_LISP_OBJECT, + which is used for specifying either property methods or disksave + methods (or in the future, any other less-used methods). + + Remove the for_disksave argument to finalize_process_data. Don't + provide a disksaver for processes because no one currently needs + it. + + Clean up various places where objects didn't provide a print method. + It was made mandatory in previous changes, and all methods now + either provide their own print method or use internal_object_printer + or external_object_printer. + + Change the definition of CONSOLE_LIVE_P to use the contype enum + rather than looking into the conmeths structure -- in some weird + situations with dead objects, the conmeths structure is NULL, + and printing such objects from debug_print() will crash if we try + to look into the conmeths structure. + + +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 + 2010-02-24 Didier Verna <didier@xemacs.org> * glyphs.c: Clarify comment about potential_pixmap_file_instantiator.
--- a/src/alloc.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/alloc.c Wed Feb 24 19:04:27 2010 -0600 @@ -562,6 +562,13 @@ } #endif /* NEW_GC && 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 NEW_GC /* lcrecords are chained together through their "next" field. After doing the mark phase, GC will walk this linked list @@ -571,70 +578,75 @@ #ifdef NEW_GC /* 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)); set_lheader_implementation (lheader, implementation); + lheader->uid = lrecord_uid_counter++; #ifdef ALLOC_TYPE_STATS inc_lrecord_stats (size, lheader); #endif /* ALLOC_TYPE_STATS */ if (implementation->finalizer) add_finalizable_obj (wrap_pointer_1 (lheader)); - 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 */ - if (implementation->finalizer) - add_finalizable_obj (wrap_pointer_1 (lheader)); - NOSEEUM_INCREMENT_CONS_COUNTER (size, implementation->name); - return lheader; -} - -void * -alloc_lrecord_array (Bytecount size, int elemcount, + 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); +} + +Lisp_Object +noseeum_alloc_lrecord (const struct lrecord_implementation *implementation) +{ + type_checking_assert (implementation->static_size > 0); + return noseeum_alloc_sized_lrecord (implementation->static_size, implementation); +} + +Lisp_Object +alloc_sized_lrecord_array (Bytecount size, int elemcount, + const struct lrecord_implementation *implementation) +{ struct lrecord_header *lheader; Rawbyte *start, *stop; - 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_array (size, elemcount); gc_checking_assert (LRECORD_FREE_P (lheader)); - + for (start = (Rawbyte *) lheader, - stop = ((Rawbyte *) lheader) + (size * elemcount -1); + /* #### FIXME: why is this -1 present? */ + stop = ((Rawbyte *) lheader) + (size * elemcount -1); start < stop; start += size) { struct lrecord_header *lh = (struct lrecord_header *) start; @@ -646,8 +658,18 @@ if (implementation->finalizer) add_finalizable_obj (wrap_pointer_1 (lh)); } + INCREMENT_CONS_COUNTER (size * elemcount, implementation->name); - return lheader; + return wrap_pointer_1 (lheader); +} + +Lisp_Object +alloc_lrecord_array (int elemcount, + const struct lrecord_implementation *implementation) +{ + type_checking_assert (implementation->static_size > 0); + return alloc_sized_lrecord_array (implementation->static_size, elemcount, + implementation); } void @@ -662,20 +684,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); @@ -688,7 +707,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 */ @@ -723,7 +750,7 @@ } } if (lrecord->implementation->finalizer) - lrecord->implementation->finalizer (lrecord, 0); + lrecord->implementation->finalizer (lrecord); xfree (lrecord); return; } @@ -741,9 +768,17 @@ for (header = all_lcrecords; header; header = header->next) { - if (LHEADER_IMPLEMENTATION (&header->lheader)->finalizer && - !header->free) - LHEADER_IMPLEMENTATION (&header->lheader)->finalizer (header, 1); + struct lrecord_header *objh = &header->lheader; + const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (objh); +#if 0 /* possibly useful for debugging */ + if (!RECORD_DUMPABLE (objh) && !header->free) + { + stderr_out ("Disksaving a non-dumpable object: "); + debug_print (wrap_pointer_1 (header)); + } +#endif + if (imp->disksaver && !header->free) + (imp->disksaver) (wrap_pointer_1 (header)); } #endif /* not NEW_GC */ } @@ -1181,14 +1216,14 @@ #endif /* (not) NEW_GC */ #ifdef NEW_GC -#define ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, lrec_ptr) \ +#define ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, lrec_ptr)\ do { \ - (var) = alloc_lrecord_type (lisp_type, lrec_ptr); \ + (var) = (lisp_type *) XPNTR (ALLOC_LISP_OBJECT (type)); \ } while (0) #define NOSEEUM_ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, \ lrec_ptr) \ do { \ - (var) = noseeum_alloc_lrecord_type (lisp_type, lrec_ptr); \ + (var) = (lisp_type *) XPNTR (noseeum_alloc_lrecord (lrec_ptr)); \ } while (0) #else /* not NEW_GC */ #define ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, lrec_ptr) \ @@ -1247,18 +1282,14 @@ { 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_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("cons", cons, + mark_cons, print_cons, 0, cons_equal, + /* + * No `hash' method needed. + * internal_hash knows how to + * handle conses. + */ + 0, cons_description, Lisp_Cons); DEFUN ("cons", Fcons, 2, 2, 0, /* Create a new cons cell, give it CAR and CDR as components, and return it. @@ -1583,13 +1614,12 @@ { XD_END } }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("vector", vector, - 1, /*dumpable-flag*/ - mark_vector, print_vector, 0, - vector_equal, - vector_hash, - vector_description, - size_vector, Lisp_Vector); +DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("vector", vector, + mark_vector, print_vector, 0, + vector_equal, + vector_hash, + vector_description, + size_vector, Lisp_Vector); /* #### should allocate `small' vectors from a frob-block */ static Lisp_Vector * make_vector_internal (Elemcount sizei) @@ -1597,8 +1627,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; @@ -1756,8 +1786,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; @@ -2320,8 +2350,7 @@ standard way to do finalization when using SWEEP_FIXED_TYPE_BLOCK(). */ -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, - 1, /*dumpable-flag*/ +DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT ("string", string, mark_string, print_string, 0, string_equal, 0, string_description, @@ -2329,6 +2358,7 @@ string_putprop, string_remprop, string_plist, + 0 /* no disksaver */, Lisp_String); #endif /* not NEW_GC */ @@ -2370,17 +2400,17 @@ #endif /* not NEW_GC */ #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, - 1, /*dumpable-flag*/ - mark_string, print_string, - 0, - string_equal, 0, - string_description, - string_getprop, - string_putprop, - string_remprop, - string_plist, - Lisp_String); +DEFINE_DUMPABLE_GENERAL_LISP_OBJECT ("string", string, + mark_string, print_string, + 0, + string_equal, 0, + string_description, + string_getprop, + string_putprop, + string_remprop, + string_plist, + 0 /* no disksaver */, + Lisp_String); static const struct memory_description string_direct_data_description[] = { @@ -2395,13 +2425,12 @@ } -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("string-direct-data", - string_direct_data, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - string_direct_data_description, - size_string_direct_data, - Lisp_String_Direct_Data); +DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT ("string-direct-data", + string_direct_data, + 0, + string_direct_data_description, + size_string_direct_data, + Lisp_String_Direct_Data); static const struct memory_description string_indirect_data_description[] = { @@ -2411,12 +2440,11 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("string-indirect-data", - string_indirect_data, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - string_indirect_data_description, - Lisp_String_Indirect_Data); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("string-indirect-data", + string_indirect_data, + 0, + string_indirect_data_description, + Lisp_String_Indirect_Data); #endif /* NEW_GC */ #ifndef NEW_GC @@ -2520,7 +2548,7 @@ assert (length >= 0 && fullsize > 0); #ifdef NEW_GC - s = alloc_lrecord_type (Lisp_String, &lrecord_string); + s = XSTRING (ALLOC_LISP_OBJECT (string)); #else /* not NEW_GC */ /* Allocate the string header */ ALLOCATE_FIXED_TYPE (string, Lisp_String, s); @@ -2535,8 +2563,7 @@ #ifdef NEW_GC set_lispstringp_direct (s); STRING_DATA_OBJECT (s) = - wrap_string_direct_data (alloc_lrecord (fullsize, - &lrecord_string_direct_data)); + alloc_sized_lrecord (fullsize, &lrecord_string_direct_data); #else /* not NEW_GC */ set_lispstringp_data (s, BIG_STRING_FULLSIZE_P (fullsize) ? allocate_big_string_chars (length + 1) @@ -2983,7 +3010,7 @@ #endif #ifdef NEW_GC - s = alloc_lrecord_type (Lisp_String, &lrecord_string); + s = XSTRING (ALLOC_LISP_OBJECT (string)); mcpro (wrap_pointer_1 (s)); /* otherwise nocopy_strings get collected and static data is tried to be freed. */ @@ -2998,10 +3025,7 @@ s->plist = Qnil; #ifdef NEW_GC set_lispstringp_indirect (s); - STRING_DATA_OBJECT (s) = - wrap_string_indirect_data - (alloc_lrecord_type (Lisp_String_Indirect_Data, - &lrecord_string_indirect_data)); + STRING_DATA_OBJECT (s) = ALLOC_LISP_OBJECT (string_indirect_data); XSTRING_INDIRECT_DATA_DATA (STRING_DATA_OBJECT (s)) = (Ibyte *) contents; XSTRING_INDIRECT_DATA_SIZE (STRING_DATA_OBJECT (s)) = length; #else /* not NEW_GC */ @@ -3022,7 +3046,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. @@ -3035,11 +3059,8 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("free", free, - 0, /*dumpable-flag*/ - 0, internal_object_printer, - 0, 0, 0, free_description, - struct free_lcrecord_header); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("free", free, 0, free_description, + struct free_lcrecord_header); const struct memory_description lcrecord_list_description[] = { { XD_LISP_OBJECT, offsetof (struct lcrecord_list, free), 0, { 0 }, @@ -3084,21 +3105,19 @@ 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_NODUMP_INTERNAL_LISP_OBJECT ("lcrecord-list", lcrecord_list, + mark_lcrecord_list, + lcrecord_list_description, + struct lcrecord_list); Lisp_Object make_lcrecord_list (Elemcount size, const struct lrecord_implementation *implementation) { - /* Don't use old_alloc_lcrecord_type() avoid infinite recursion - allocating this, */ + /* Don't use alloc_automanaged_lcrecord() avoid infinite recursion + allocating this. */ struct lcrecord_list *p = (struct lcrecord_list *) - old_basic_alloc_lcrecord (sizeof (struct lcrecord_list), - &lrecord_lcrecord_list); + old_alloc_lcrecord (&lrecord_lcrecord_list); p->implementation = implementation; p->size = size; @@ -3144,7 +3163,7 @@ return val; } else - return wrap_pointer_1 (old_basic_alloc_lcrecord (list->size, + return wrap_pointer_1 (old_alloc_sized_lcrecord (list->size, list->implementation)); } @@ -3197,7 +3216,7 @@ gc_checking_assert (!OBJECT_DUMPED_P (lcrecord)); if (implementation->finalizer) - implementation->finalizer (lheader, 0); + implementation->finalizer (lheader); /* Yes, there are two ways to indicate freeness -- the type is lrecord_type_free or the ->free flag is set. We used to do only the latter; now we do the former as well for KKCC purposes. Probably @@ -3211,16 +3230,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 @@ -3557,7 +3582,7 @@ if (! MARKED_RECORD_HEADER_P (h) && ! header->free) { if (LHEADER_IMPLEMENTATION (h)->finalizer) - LHEADER_IMPLEMENTATION (h)->finalizer (h, 0); + LHEADER_IMPLEMENTATION (h)->finalizer (h); } } @@ -5081,16 +5106,16 @@ 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); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (string_indirect_data); - INIT_LRECORD_IMPLEMENTATION (string_direct_data); + INIT_LISP_OBJECT (string_indirect_data); + INIT_LISP_OBJECT (string_direct_data); #endif /* NEW_GC */ #ifndef NEW_GC - INIT_LRECORD_IMPLEMENTATION (lcrecord_list); - INIT_LRECORD_IMPLEMENTATION (free); + INIT_LISP_OBJECT (lcrecord_list); + INIT_LISP_OBJECT (free); #endif /* not NEW_GC */ staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
--- a/src/buffer.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/buffer.c Wed Feb 24 19:04:27 2010 -0600 @@ -234,11 +234,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("buffer-text", buffer_text, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - buffer_text_description_1, - Lisp_Buffer_Text); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("buffer-text", buffer_text, + 0, buffer_text_description_1, + Lisp_Buffer_Text); #endif /* NEW_GC */ static const struct sized_memory_description buffer_text_description = { @@ -333,11 +331,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_NODUMP_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. @@ -603,9 +600,10 @@ static struct buffer * allocate_buffer (void) { - struct buffer *b = ALLOC_LCRECORD_TYPE (struct buffer, &lrecord_buffer); - - COPY_LCRECORD (b, XBUFFER (Vbuffer_defaults)); + Lisp_Object obj = ALLOC_LISP_OBJECT (buffer); + struct buffer *b = XBUFFER (obj); + + COPY_LISP_OBJECT (b, XBUFFER (Vbuffer_defaults)); return b; } @@ -1779,7 +1777,7 @@ struct overhead_stats *ovstats) { xzero (*stats); - stats->other += LISPOBJ_STORAGE_SIZE (b, sizeof (*b), ovstats); + stats->other += LISP_OBJECT_STORAGE_SIZE (b, sizeof (*b), ovstats); stats->text += compute_buffer_text_usage (b, ovstats); stats->markers += compute_buffer_marker_usage (b, ovstats); stats->extents += compute_buffer_extent_usage (b, ovstats); @@ -1910,9 +1908,9 @@ void syms_of_buffer (void) { - INIT_LRECORD_IMPLEMENTATION (buffer); + INIT_LISP_OBJECT (buffer); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (buffer_text); + INIT_LISP_OBJECT (buffer_text); #endif /* NEW_GC */ DEFSYMBOL (Qbuffer_live_p); @@ -2143,9 +2141,8 @@ do \ { \ struct symbol_value_forward *I_hate_C = \ - alloc_lrecord_type (struct symbol_value_forward, \ - &lrecord_symbol_value_forward); \ - /*mcpro ((Lisp_Object) I_hate_C);*/ \ + XSYMBOL_VALUE_FORWARD (ALLOC_LISP_OBJECT (symbol_value_forward)); \ + /*mcpro ((Lisp_Object) I_hate_C);*/ \ \ I_hate_C->magic.value = &(buffer_local_flags.field_name); \ I_hate_C->magic.type = forward_type; \ @@ -2219,7 +2216,7 @@ static void nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap) { - ZERO_LCRECORD (b); + ZERO_LISP_OBJECT (b); b->extent_info = Qnil; b->indirect_children = Qnil; @@ -2234,13 +2231,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/buffer.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/buffer.h Wed Feb 24 19:04:27 2010 -0600 @@ -80,7 +80,7 @@ struct buffer_text { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Ibyte *beg; /* Actual address of buffer contents. */ Bytebpos gpt; /* Index of gap in buffer. */ @@ -144,7 +144,7 @@ #ifdef NEW_GC typedef struct buffer_text Lisp_Buffer_Text; -DECLARE_LRECORD (buffer_text, Lisp_Buffer_Text); +DECLARE_LISP_OBJECT (buffer_text, Lisp_Buffer_Text); #define XBUFFER_TEXT(x) \ XRECORD (x, buffer_text, Lisp_Buffer_Text) @@ -157,7 +157,7 @@ struct buffer { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; /* This structure holds the coordinates of the buffer contents in ordinary buffers. In indirect buffers, this is not used. */ @@ -268,7 +268,7 @@ #undef MARKED_SLOT }; -DECLARE_LRECORD (buffer, struct buffer); +DECLARE_LISP_OBJECT (buffer, struct buffer); #define XBUFFER(x) XRECORD (x, buffer, struct buffer) #define wrap_buffer(p) wrap_record (p, buffer) #define BUFFERP(x) RECORDP (x, buffer)
--- a/src/bytecode.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/bytecode.c Wed Feb 24 19:04:27 2010 -0600 @@ -65,11 +65,11 @@ make_compiled_function_args (int totalargs) { Lisp_Compiled_Function_Args *args; - args = (Lisp_Compiled_Function_Args *) - alloc_lrecord - (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args, - Lisp_Object, args, totalargs), - &lrecord_compiled_function_args); + args = XCOMPILED_FUNCTION_ARGS + (alloc_sized_lrecord + (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args, + Lisp_Object, args, totalargs), + &lrecord_compiled_function_args)); args->size = totalargs; return wrap_compiled_function_args (args); } @@ -90,13 +90,12 @@ { XD_END } }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("compiled-function-args", - compiled_function_args, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - compiled_function_args_description, - size_compiled_function_args, - Lisp_Compiled_Function_Args); +DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT ("compiled-function-args", + compiled_function_args, + 0, + compiled_function_args_description, + size_compiled_function_args, + Lisp_Compiled_Function_Args); #endif /* NEW_GC */ EXFUN (Ffetch_bytecode, 1); @@ -2374,14 +2373,13 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function, - 1, /*dumpable_flag*/ - mark_compiled_function, - print_compiled_function, 0, - compiled_function_equal, - compiled_function_hash, - compiled_function_description, - Lisp_Compiled_Function); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("compiled-function", compiled_function, + mark_compiled_function, + print_compiled_function, 0, + compiled_function_equal, + compiled_function_hash, + compiled_function_description, + Lisp_Compiled_Function); DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /* @@ -2756,9 +2754,9 @@ void syms_of_bytecode (void) { - INIT_LRECORD_IMPLEMENTATION (compiled_function); + INIT_LISP_OBJECT (compiled_function); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (compiled_function_args); + INIT_LISP_OBJECT (compiled_function_args); #endif /* NEW_GC */ DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state);
--- a/src/bytecode.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/bytecode.h Wed Feb 24 19:04:27 2010 -0600 @@ -34,14 +34,14 @@ #ifdef NEW_GC struct compiled_function_args { - struct lrecord_header header; + LISP_OBJECT_HEADER header; long size; Lisp_Object args[1]; }; typedef struct compiled_function_args Lisp_Compiled_Function_Args; -DECLARE_LRECORD (compiled_function_args, Lisp_Compiled_Function_Args); +DECLARE_LISP_OBJECT (compiled_function_args, Lisp_Compiled_Function_Args); #define XCOMPILED_FUNCTION_ARGS(x) \ XRECORD (x, compiled_function_args, Lisp_Compiled_Function_Args) @@ -83,7 +83,7 @@ struct Lisp_Compiled_Function { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; unsigned short stack_depth; unsigned short specpdl_depth; struct @@ -148,7 +148,7 @@ int stack_depth, Lisp_Object *constants_data); -DECLARE_LRECORD (compiled_function, Lisp_Compiled_Function); +DECLARE_LISP_OBJECT (compiled_function, Lisp_Compiled_Function); #define XCOMPILED_FUNCTION(x) XRECORD (x, compiled_function, \ Lisp_Compiled_Function) #define wrap_compiled_function(p) wrap_record (p, compiled_function)
--- a/src/casetab.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/casetab.c Wed Feb 24 19:04:27 2010 -0600 @@ -122,16 +122,15 @@ }; -DEFINE_LRECORD_IMPLEMENTATION("case-table", case_table, - 1, /*dumpable-flag*/ - mark_case_table, print_case_table, 0, - 0, 0, case_table_description, Lisp_Case_Table); +DEFINE_DUMPABLE_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) { @@ -147,7 +146,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, /* @@ -512,7 +511,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/casetab.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/casetab.h Wed Feb 24 19:04:27 2010 -0600 @@ -25,7 +25,7 @@ struct Lisp_Case_Table { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object downcase_table; Lisp_Object upcase_table; Lisp_Object case_canon_table; @@ -34,7 +34,7 @@ }; typedef struct Lisp_Case_Table Lisp_Case_Table; -DECLARE_LRECORD (case_table, Lisp_Case_Table); +DECLARE_LISP_OBJECT (case_table, Lisp_Case_Table); #define XCASE_TABLE(x) XRECORD (x, case_table, Lisp_Case_Table) #define wrap_case_table(p) wrap_record (p, case_table) #define CASE_TABLEP(x) RECORDP (x, case_table)
--- a/src/charset.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/charset.h Wed Feb 24 19:04:27 2010 -0600 @@ -185,7 +185,7 @@ struct Lisp_Charset { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; int id; Lisp_Object name; @@ -246,7 +246,7 @@ }; typedef struct Lisp_Charset Lisp_Charset; -DECLARE_LRECORD (charset, Lisp_Charset); +DECLARE_LISP_OBJECT (charset, Lisp_Charset); #define XCHARSET(x) XRECORD (x, charset, Lisp_Charset) #define wrap_charset(p) wrap_record (p, charset) #define CHARSETP(x) RECORDP (x, charset)
--- a/src/chartab.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/chartab.c Wed Feb 24 19:04:27 2010 -0600 @@ -140,13 +140,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_DUMPABLE_LISP_OBJECT ("char-table-entry", char_table_entry, + mark_char_table_entry, internal_object_printer, + 0, char_table_entry_equal, + char_table_entry_hash, + char_table_entry_description, + Lisp_Char_Table_Entry); #endif /* MULE */ @@ -395,12 +394,11 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table, - 1, /*dumpable-flag*/ - mark_char_table, print_char_table, 0, - char_table_equal, char_table_hash, - char_table_description, - Lisp_Char_Table); +DEFINE_DUMPABLE_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); DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* Return non-nil if OBJECT is a char table. @@ -479,7 +477,7 @@ if (!EQ (ct->level1[i], Qnull_pointer) && CHAR_TABLE_ENTRYP (ct->level1[i]) && !OBJECT_DUMPED_P (ct->level1[1])) - FREE_LCRECORD (ct->level1[i]); + FREE_LISP_OBJECT (ct->level1[i]); ct->level1[i] = value; } #endif /* MULE */ @@ -598,13 +596,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 @@ -634,13 +630,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 @@ -648,8 +644,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++) { @@ -660,7 +656,7 @@ ctenew->level2[i] = new_; } - return wrap_char_table_entry (ctenew); + return obj; } #endif /* MULE */ @@ -679,12 +675,12 @@ CHECK_CHAR_TABLE (char_table); ct = XCHAR_TABLE (char_table); assert(!ct->mirror_table_p); - 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 = 0; - obj = wrap_char_table (ctnew); for (i = 0; i < NUM_ASCII_CHARS; i++) { @@ -1075,7 +1071,7 @@ int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; if (CHAR_TABLE_ENTRYP (ct->level1[lb]) && !OBJECT_DUMPED_P (ct->level1[lb])) - FREE_LCRECORD (ct->level1[lb]); + FREE_LISP_OBJECT (ct->level1[lb]); ct->level1[lb] = val; } break; @@ -1832,10 +1828,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/chartab.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/chartab.h Wed Feb 24 19:04:27 2010 -0600 @@ -42,7 +42,7 @@ struct Lisp_Char_Table_Entry { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; /* In the interests of simplicity, we just use a fixed 96-entry table. If we felt like being smarter, we could make this @@ -51,7 +51,7 @@ }; typedef struct Lisp_Char_Table_Entry Lisp_Char_Table_Entry; -DECLARE_LRECORD (char_table_entry, Lisp_Char_Table_Entry); +DECLARE_LISP_OBJECT (char_table_entry, Lisp_Char_Table_Entry); #define XCHAR_TABLE_ENTRY(x) \ XRECORD (x, char_table_entry, Lisp_Char_Table_Entry) #define wrap_char_table_entry(p) wrap_record (p, char_table_entry) @@ -80,7 +80,7 @@ struct Lisp_Char_Table { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object ascii[NUM_ASCII_CHARS]; Lisp_Object default_; @@ -128,7 +128,7 @@ }; typedef struct Lisp_Char_Table Lisp_Char_Table; -DECLARE_LRECORD (char_table, Lisp_Char_Table); +DECLARE_LISP_OBJECT (char_table, Lisp_Char_Table); #define XCHAR_TABLE(x) XRECORD (x, char_table, Lisp_Char_Table) #define wrap_char_table(p) wrap_record (p, char_table) #define CHAR_TABLEP(x) RECORDP (x, char_table)
--- a/src/console-gtk-impl.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/console-gtk-impl.h Wed Feb 24 19:04:27 2010 -0600 @@ -50,7 +50,7 @@ struct gtk_device { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ /* Gtk application info. */ GtkWidget *gtk_app_shell; @@ -115,7 +115,7 @@ #ifdef NEW_GC typedef struct gtk_device Lisp_Gtk_Device; -DECLARE_LRECORD (gtk_device, Lisp_Gtk_Device); +DECLARE_LISP_OBJECT (gtk_device, Lisp_Gtk_Device); #define XGTK_DEVICE(x) \ XRECORD (x, gtk_device, Lisp_Gtk_Device) @@ -144,7 +144,7 @@ struct gtk_frame { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ /* The widget of this frame. */ @@ -203,7 +203,7 @@ #ifdef NEW_GC typedef struct gtk_frame Lisp_Gtk_Frame; -DECLARE_LRECORD (gtk_frame, Lisp_Gtk_Frame); +DECLARE_LISP_OBJECT (gtk_frame, Lisp_Gtk_Frame); #define XGTK_FRAME(x) \ XRECORD (x, gtk_frame, Lisp_Gtk_Frame)
--- a/src/console-impl.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/console-impl.h Wed Feb 24 19:04:27 2010 -0600 @@ -409,7 +409,7 @@ struct console { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; /* Description of this console's methods. */ struct console_methods *conmeths; @@ -453,7 +453,11 @@ /* Redefine basic properties more efficiently */ #undef CONSOLE_LIVE_P -#define CONSOLE_LIVE_P(con) (!EQ (CONSOLE_TYPE (con), Qdead)) +/* The following is the old way, but it can lead to crashes in certain + weird circumstances, where you might want to be printing a console via + debug_print() */ +/* #define CONSOLE_LIVE_P(con) (!EQ (CONSOLE_TYPE (con), Qdead)) */ +#define CONSOLE_LIVE_P(con) ((con)->contype != dead_console) #undef CONSOLE_DEVICE_LIST #define CONSOLE_DEVICE_LIST(con) ((con)->device_list)
--- a/src/console-msw-impl.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/console-msw-impl.h Wed Feb 24 19:04:27 2010 -0600 @@ -57,7 +57,7 @@ struct Lisp_Devmode { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; /* Pointer to the DEVMODE structure */ DEVMODEW *devmode; @@ -82,7 +82,7 @@ struct mswindows_device { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Lisp_Object fontlist; /* List of (STRING . FIXED-P), device fonts */ HDC hcdc; /* Compatible DC */ @@ -94,7 +94,7 @@ #ifdef NEW_GC typedef struct mswindows_device Lisp_Mswindows_Device; -DECLARE_LRECORD (mswindows_device, Lisp_Mswindows_Device); +DECLARE_LISP_OBJECT (mswindows_device, Lisp_Mswindows_Device); #define XMSWINDOWS_DEVICE(x) \ XRECORD (x, mswindows_device, Lisp_Mswindows_Device) @@ -110,7 +110,7 @@ struct msprinter_device { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ HDC hdc, hcdc; /* Printer and the comp. DCs */ HANDLE hprinter; @@ -122,7 +122,7 @@ #ifdef NEW_GC typedef struct msprinter_device Lisp_Msprinter_Device; -DECLARE_LRECORD (msprinter_device, Lisp_Msprinter_Device); +DECLARE_LISP_OBJECT (msprinter_device, Lisp_Msprinter_Device); #define XMSPRINTER_DEVICE(x) \ XRECORD (x, msprinter_device, Lisp_Msprinter_Device) @@ -168,7 +168,7 @@ struct mswindows_frame { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ /* win32 window handle */ @@ -230,7 +230,7 @@ #ifdef NEW_GC typedef struct mswindows_frame Lisp_Mswindows_Frame; -DECLARE_LRECORD (mswindows_frame, Lisp_Mswindows_Frame); +DECLARE_LISP_OBJECT (mswindows_frame, Lisp_Mswindows_Frame); #define XMSWINDOWS_FRAME(x) \ XRECORD (x, mswindows_frame, Lisp_Mswindows_Frame) @@ -312,7 +312,7 @@ struct mswindows_dialog_id { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object frame; Lisp_Object callbacks;
--- a/src/console-msw.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/console-msw.h Wed Feb 24 19:04:27 2010 -0600 @@ -57,7 +57,7 @@ typedef struct Lisp_Devmode Lisp_Devmode; -DECLARE_LRECORD (devmode, Lisp_Devmode); +DECLARE_LISP_OBJECT (devmode, Lisp_Devmode); #define XDEVMODE(x) XRECORD (x, devmode, Lisp_Devmode) #define wrap_devmode(p) wrap_record (p, devmode) #define DEVMODEP(x) RECORDP (x, devmode) @@ -210,7 +210,7 @@ struct mswindows_dialog_id; -DECLARE_LRECORD (mswindows_dialog_id, struct mswindows_dialog_id); +DECLARE_LISP_OBJECT (mswindows_dialog_id, struct mswindows_dialog_id); #define XMSWINDOWS_DIALOG_ID(x) XRECORD (x, mswindows_dialog_id, struct mswindows_dialog_id) #define wrap_mswindows_dialog_id(p) wrap_record (p, mswindows_dialog_id) #define MSWINDOWS_DIALOG_IDP(x) RECORDP (x, mswindows_dialog_id)
--- a/src/console-stream-impl.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/console-stream-impl.h Wed Feb 24 19:04:27 2010 -0600 @@ -35,7 +35,7 @@ struct stream_console { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ FILE *in; FILE *out; @@ -47,7 +47,7 @@ #ifdef NEW_GC typedef struct stream_console Lisp_Stream_Console; -DECLARE_LRECORD (stream_console, Lisp_Stream_Console); +DECLARE_LISP_OBJECT (stream_console, Lisp_Stream_Console); #define XSTREAM_CONSOLE(x) \ XRECORD (x, stream_console, Lisp_Stream_Console)
--- a/src/console-stream.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/console-stream.c Wed Feb 24 19:04:27 2010 -0600 @@ -54,11 +54,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("stream-console", stream_console, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - stream_console_data_description_1, - Lisp_Stream_Console); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("stream-console", stream_console, + 0, stream_console_data_description_1, + Lisp_Stream_Console); #else /* not NEW_GC */ const struct sized_memory_description stream_console_data_description = { sizeof (struct stream_console), stream_console_data_description_1 @@ -73,8 +71,8 @@ #ifdef NEW_GC if (CONSOLE_STREAM_DATA (con) == NULL) - CONSOLE_STREAM_DATA (con) = alloc_lrecord_type (struct stream_console, - &lrecord_stream_console); + CONSOLE_STREAM_DATA (con) = + XSTREAM_CONSOLE (ALLOC_LISP_OBJECT (stream_console)); #else /* not NEW_GC */ if (CONSOLE_STREAM_DATA (con) == NULL) CONSOLE_STREAM_DATA (con) = xnew_and_zero (struct stream_console);
--- a/src/console-tty-impl.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/console-tty-impl.h Wed Feb 24 19:04:27 2010 -0600 @@ -40,7 +40,7 @@ struct tty_console { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ int infd, outfd; Lisp_Object instream, outstream; @@ -207,7 +207,7 @@ #ifdef NEW_GC typedef struct tty_console Lisp_Tty_Console; -DECLARE_LRECORD (tty_console, Lisp_Tty_Console); +DECLARE_LISP_OBJECT (tty_console, Lisp_Tty_Console); #define XTTY_CONSOLE(x) \ XRECORD (x, tty_console, Lisp_Tty_Console) @@ -256,7 +256,7 @@ struct tty_device { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ #ifdef HAVE_TERMIOS speed_t ospeed; /* Output speed (from sg_ospeed) */ @@ -268,7 +268,7 @@ #ifdef NEW_GC typedef struct tty_device Lisp_Tty_Device; -DECLARE_LRECORD (tty_device, Lisp_Tty_Device); +DECLARE_LISP_OBJECT (tty_device, Lisp_Tty_Device); #define XTTY_DEVICE(x) \ XRECORD (x, tty_device, Lisp_Tty_Device)
--- a/src/console-tty.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/console-tty.c Wed Feb 24 19:04:27 2010 -0600 @@ -60,11 +60,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("tty-console", tty_console, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - tty_console_data_description_1, - Lisp_Tty_Console); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("tty-console", tty_console, + 0, tty_console_data_description_1, + Lisp_Tty_Console); #else /* not NEW_GC */ const struct sized_memory_description tty_console_data_description = { sizeof (struct tty_console), tty_console_data_description_1 @@ -77,8 +75,7 @@ { /* zero out all slots except the lisp ones ... */ #ifdef NEW_GC - CONSOLE_TTY_DATA (con) = alloc_lrecord_type (struct tty_console, - &lrecord_tty_console); + CONSOLE_TTY_DATA (con) = XTTY_CONSOLE (ALLOC_LISP_OBJECT (tty_console)); #else /* not NEW_GC */ CONSOLE_TTY_DATA (con) = xnew_and_zero (struct tty_console); #endif /* not NEW_GC */
--- a/src/console-x-impl.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/console-x-impl.h Wed Feb 24 19:04:27 2010 -0600 @@ -45,7 +45,7 @@ struct x_device { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ /* The X connection of this device. */ Display *display; @@ -167,7 +167,7 @@ #ifdef NEW_GC typedef struct x_device Lisp_X_Device; -DECLARE_LRECORD (x_device, Lisp_X_Device); +DECLARE_LISP_OBJECT (x_device, Lisp_X_Device); #define XX_DEVICE(x) \ XRECORD (x, x_device, Lisp_X_Device) @@ -243,7 +243,7 @@ struct x_frame { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ /* The widget of this frame. @@ -351,7 +351,7 @@ #ifdef NEW_GC typedef struct x_frame Lisp_X_Frame; -DECLARE_LRECORD (x_frame, Lisp_X_Frame); +DECLARE_LISP_OBJECT (x_frame, Lisp_X_Frame); #define XX_FRAME(x) \ XRECORD (x, x_frame, Lisp_X_Frame)
--- a/src/console.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/console.c Wed Feb 24 19:04:27 2010 -0600 @@ -173,11 +173,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_NODUMP_LISP_OBJECT ("console", console, mark_console, + print_console, 0, 0, 0, + console_description, + struct console); static void @@ -194,13 +193,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)); + COPY_LISP_OBJECT (con, XCONSOLE (Vconsole_defaults)); - console = wrap_console (con); GCPRO1 (console); con->conmeths = decode_console_type (type, ERROR_ME); @@ -663,7 +661,7 @@ static void nuke_all_console_slots (struct console *con, Lisp_Object zap) { - ZERO_LCRECORD (con); + ZERO_LISP_OBJECT (con); #define MARKED_SLOT(x) con->x = zap; #include "conslots.h" @@ -1187,12 +1185,12 @@ void syms_of_console (void) { - INIT_LRECORD_IMPLEMENTATION (console); + INIT_LISP_OBJECT (console); #ifdef NEW_GC #ifdef HAVE_TTY - INIT_LRECORD_IMPLEMENTATION (tty_console); + INIT_LISP_OBJECT (tty_console); #endif - INIT_LRECORD_IMPLEMENTATION (stream_console); + INIT_LISP_OBJECT (stream_console); #endif /* NEW_GC */ DEFSUBR (Fvalid_console_type_p); @@ -1320,9 +1318,8 @@ #define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magic_fun) \ do { \ struct symbol_value_forward *I_hate_C = \ - alloc_lrecord_type (struct symbol_value_forward, \ - &lrecord_symbol_value_forward); \ - /*mcpro ((Lisp_Object) I_hate_C);*/ \ + XSYMBOL_VALUE_FORWARD (ALLOC_LISP_OBJECT (symbol_value_forward)); \ + /*mcpro ((Lisp_Object) I_hate_C);*/ \ \ I_hate_C->magic.value = &(console_local_flags.field_name); \ I_hate_C->magic.type = forward_type; \ @@ -1398,13 +1395,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/console.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/console.h Wed Feb 24 19:04:27 2010 -0600 @@ -79,7 +79,7 @@ struct console; -DECLARE_LRECORD (console, struct console); +DECLARE_LISP_OBJECT (console, struct console); #define XCONSOLE(x) XRECORD (x, console, struct console) #define wrap_console(p) wrap_record (p, console) #define CONSOLEP(x) RECORDP (x, console)
--- a/src/data.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/data.c Wed Feb 24 19:04:27 2010 -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. @@ -2642,13 +2642,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; @@ -2662,12 +2660,11 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("weak-list", weak_list, - 1, /*dumpable-flag*/ - mark_weak_list, print_weak_list, - 0, weak_list_equal, weak_list_hash, - weak_list_description, - struct weak_list); +DEFINE_DUMPABLE_LISP_OBJECT ("weak-list", weak_list, + mark_weak_list, print_weak_list, + 0, weak_list_equal, weak_list_hash, + weak_list_description, + struct weak_list); /* -- we do not mark the list elements (either the elements themselves or the cons cells that hold them) in the normal marking phase. @@ -3116,10 +3113,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); @@ -3133,12 +3128,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_NODUMP_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. @@ -3337,24 +3330,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; @@ -3375,12 +3367,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_NODUMP_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. @@ -3518,9 +3509,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 Wed Feb 24 11:08:30 2010 +0100 +++ b/src/database.c Wed Feb 24 19:04:27 2010 -0600 @@ -147,7 +147,7 @@ struct Lisp_Database { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object fname; int mode; int access_; @@ -180,7 +180,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; @@ -235,25 +236,18 @@ } static void -finalize_database (void *header, int for_disksave) +finalize_database (void *header) { Lisp_Database *db = (Lisp_Database *) header; - if (for_disksave) - { - invalid_operation - ("Can't dump an emacs containing database objects", - wrap_database (db)); - } 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_NODUMP_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. @@ -860,7 +854,7 @@ void syms_of_database (void) { - INIT_LRECORD_IMPLEMENTATION (database); + INIT_LISP_OBJECT (database); DEFSYMBOL (Qdatabasep); #ifdef HAVE_DBM
--- a/src/database.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/database.h Wed Feb 24 19:04:27 2010 -0600 @@ -25,6 +25,6 @@ #define INCLUDED_database_h_ typedef struct Lisp_Database Lisp_Database; -DECLARE_LRECORD (database, Lisp_Database); +DECLARE_LISP_OBJECT (database, Lisp_Database); #endif /* INCLUDED_database_h_ */
--- a/src/device-gtk.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/device-gtk.c Wed Feb 24 19:04:27 2010 -0600 @@ -76,11 +76,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("gtk-device", gtk_device, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - gtk_device_data_description_1, - Lisp_Gtk_Device); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("gtk-device", gtk_device, + 0, gtk_device_data_description_1, + Lisp_Gtk_Device); #else /* not NEW_GC */ extern const struct sized_memory_description gtk_device_data_description; @@ -117,7 +115,7 @@ allocate_gtk_device_struct (struct device *d) { #ifdef NEW_GC - d->device_data = alloc_lrecord_type (struct gtk_device, &lrecord_gtk_device); + d->device_data = XGTK_DEVICE (ALLOC_LISP_OBJECT (gtk_device)); #else /* not NEW_GC */ d->device_data = xnew_and_zero (struct gtk_device); #endif /* not NEW_GC */ @@ -689,7 +687,7 @@ syms_of_device_gtk (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (gtk_device); + INIT_LISP_OBJECT (gtk_device); #endif /* NEW_GC */ DEFSUBR (Fgtk_keysym_on_keyboard_p);
--- a/src/device-impl.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/device-impl.h Wed Feb 24 19:04:27 2010 -0600 @@ -71,7 +71,7 @@ struct device { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; /* Methods for this device's console. This can also be retrieved through device->console, but it's faster this way. */
--- a/src/device-msw.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/device-msw.c Wed Feb 24 19:04:27 2010 -0600 @@ -75,11 +75,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("mswindows-device", mswindows_device, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - mswindows_device_data_description_1, - Lisp_Mswindows_Device); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("mswindows-device", mswindows_device, + 0, mswindows_device_data_description_1, + Lisp_Mswindows_Device); #else /* not NEW_GC */ extern const struct sized_memory_description mswindows_device_data_description; @@ -96,11 +94,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("msprinter-device", msprinter_device, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - msprinter_device_data_description_1, - Lisp_Msprinter_Device); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("msprinter-device", msprinter_device, + 0, msprinter_device_data_description_1, + Lisp_Msprinter_Device); #else /* not NEW_GC */ extern const struct sized_memory_description msprinter_device_data_description; @@ -166,8 +162,7 @@ init_one_device (d); #ifdef NEW_GC - d->device_data = alloc_lrecord_type (struct mswindows_device, - &lrecord_mswindows_device); + d->device_data = XMSWINDOWS_DEVICE (ALLOC_LISP_OBJECT (mswindows_device)); #else /* not NEW_GC */ d->device_data = xnew_and_zero (struct mswindows_device); #endif /* not NEW_GC */ @@ -523,8 +518,7 @@ Extbyte *printer_name; #ifdef NEW_GC - d->device_data = alloc_lrecord_type (struct msprinter_device, - &lrecord_msprinter_device); + d->device_data = XMSPRINTER_DEVICE (ALLOC_LISP_OBJECT (msprinter_device)); #else /* not NEW_GC */ d->device_data = xnew_and_zero (struct msprinter_device); #endif /* not NEW_GC */ @@ -1164,19 +1158,10 @@ } static void -finalize_devmode (void *header, int for_disksave) +finalize_devmode (void *header) { Lisp_Devmode *dm = (Lisp_Devmode *) header; - if (for_disksave) - { - Lisp_Object devmode = wrap_devmode (dm); - - invalid_operation - ("Cannot dump XEmacs containing an msprinter-settings object", - devmode); - } - assert (NILP (dm->device)); } @@ -1209,20 +1194,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_NODUMP_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); @@ -1241,7 +1225,7 @@ dm->devmode = src_devmode; } - return wrap_devmode (dm); + return obj; } DEFUN ("msprinter-settings-copy", Fmsprinter_settings_copy, 1, 1, 0, /* @@ -1377,11 +1361,11 @@ void syms_of_device_mswindows (void) { - INIT_LRECORD_IMPLEMENTATION (devmode); + INIT_LISP_OBJECT (devmode); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (mswindows_device); - INIT_LRECORD_IMPLEMENTATION (msprinter_device); + INIT_LISP_OBJECT (mswindows_device); + INIT_LISP_OBJECT (msprinter_device); #endif /* NEW_GC */ DEFSUBR (Fmsprinter_get_settings);
--- a/src/device-tty.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/device-tty.c Wed Feb 24 19:04:27 2010 -0600 @@ -49,18 +49,16 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("tty-device", tty_device, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - tty_device_data_description_1, - Lisp_Tty_Device); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("tty-device", tty_device, + 0, tty_device_data_description_1, + Lisp_Tty_Device); #endif /* NEW_GC */ static void allocate_tty_device_struct (struct device *d) { #ifdef NEW_GC - d->device_data = alloc_lrecord_type (struct tty_device, &lrecord_tty_device); + d->device_data = XTTY_DEVICE (ALLOC_LISP_OBJECT (tty_device)); #else /* not NEW_GC */ d->device_data = xnew_and_zero (struct tty_device); #endif /* not NEW_GC */ @@ -208,7 +206,7 @@ syms_of_device_tty (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (tty_device); + INIT_LISP_OBJECT (tty_device); #endif /* NEW_GC */ DEFSYMBOL (Qmake_device_early_tty_entry_point);
--- a/src/device-x.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/device-x.c Wed Feb 24 19:04:27 2010 -0600 @@ -111,11 +111,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("x-device", x_device, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - x_device_data_description_1, - Lisp_X_Device); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("x-device", x_device, + 0, x_device_data_description_1, + Lisp_X_Device); #else /* not NEW_GC */ extern const struct sized_memory_description x_device_data_description; @@ -230,7 +228,7 @@ allocate_x_device_struct (struct device *d) { #ifdef NEW_GC - d->device_data = alloc_lrecord_type (struct x_device, &lrecord_x_device); + d->device_data = XX_DEVICE (ALLOC_LISP_OBJECT (x_device)); #else /* not NEW_GC */ d->device_data = xnew_and_zero (struct x_device); #endif /* not NEW_GC */ @@ -2108,7 +2106,7 @@ syms_of_device_x (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (x_device); + INIT_LISP_OBJECT (x_device); #endif /* NEW_GC */ DEFSUBR (Fx_debug_mode);
--- a/src/device.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/device.c Wed Feb 24 19:04:27 2010 -0600 @@ -169,11 +169,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_NODUMP_LISP_OBJECT ("device", device, + mark_device, print_device, 0, 0, 0, + device_description, + struct device); int valid_device_class_p (Lisp_Object class_) @@ -201,7 +200,7 @@ static void nuke_all_device_slots (struct device *d, Lisp_Object zap) { - ZERO_LCRECORD (d); + ZERO_LISP_OBJECT (d); #define MARKED_SLOT(x) d->x = zap; #include "devslots.h" @@ -210,12 +209,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); @@ -1398,7 +1396,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/device.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/device.h Wed Feb 24 19:04:27 2010 -0600 @@ -31,7 +31,7 @@ struct device; -DECLARE_LRECORD (device, struct device); +DECLARE_LISP_OBJECT (device, struct device); #define XDEVICE(x) XRECORD (x, device, struct device) #define wrap_device(p) wrap_record (p, device) #define DEVICEP(x) RECORDP (x, device)
--- a/src/dialog-msw.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/dialog-msw.c Wed Feb 24 19:04:27 2010 -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_NODUMP_INTERNAL_LISP_OBJECT ("mswindows-dialog-id", + mswindows_dialog_id, + mark_mswindows_dialog_id, + mswindows_dialog_id_description, + struct 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_begin (template_), FRAME_MSWINDOWS_HANDLE (f), dialog_proc, - (LPARAM) STORE_LISP_IN_VOID (dialog_data)); + (LPARAM) STORE_LISP_IN_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/dynarr.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/dynarr.c Wed Feb 24 19:04:27 2010 -0600 @@ -284,17 +284,16 @@ } #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("dynarr", dynarr, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - 0, - Dynarr); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("dynarr", dynarr, + 0, 0, + Dynarr); static void Dynarr_lisp_realloc (Dynarr *dy, Elemcount new_size) { - void *new_base = alloc_lrecord_array (Dynarr_elsize (dy), new_size, - dy->lisp_imp); + void *new_base = + XPNTR (alloc_sized_lrecord_array (Dynarr_elsize (dy), new_size, + dy->lisp_imp)); if (dy->base) memcpy (new_base, dy->base, (Dynarr_max (dy) < new_size ? Dynarr_max (dy) : new_size) * @@ -307,7 +306,8 @@ const struct lrecord_implementation *dynarr_imp, const struct lrecord_implementation *imp) { - Dynarr *d = (Dynarr *) alloc_lrecord (sizeof (Dynarr), dynarr_imp); + Dynarr *d = (Dynarr *) XPNTR (alloc_sized_lrecord (sizeof (Dynarr), + dynarr_imp)); d->elsize_ = elsize; d->lisp_imp = imp;
--- a/src/elhash.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/elhash.c Wed Feb 24 19:04:27 2010 -0600 @@ -96,7 +96,7 @@ struct Lisp_Hash_Table { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Elemcount size; Elemcount count; Elemcount rehash_count; @@ -421,14 +421,11 @@ } static void -finalize_hash_table (void *header, int for_disksave) +finalize_hash_table (void *header) { - if (!for_disksave) - { - Lisp_Hash_Table *ht = (Lisp_Hash_Table *) header; - free_hentries (ht->hentries, ht->size); - ht->hentries = 0; - } + Lisp_Hash_Table *ht = (Lisp_Hash_Table *) header; + free_hentries (ht->hentries, ht->size); + ht->hentries = 0; } #endif /* not NEW_GC */ @@ -455,11 +452,9 @@ htentry_weak_description_1 }; -DEFINE_LRECORD_IMPLEMENTATION ("hash-table-entry", hash_table_entry, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - htentry_description_1, - Lisp_Hash_Table_Entry); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("hash-table-entry", hash_table_entry, + 0, htentry_description_1, + Lisp_Hash_Table_Entry); #endif /* NEW_GC */ static const struct memory_description htentry_union_description_1[] = { @@ -494,20 +489,18 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table, - 1, /*dumpable-flag*/ - mark_hash_table, print_hash_table, - 0, hash_table_equal, hash_table_hash, - hash_table_description, - Lisp_Hash_Table); +DEFINE_DUMPABLE_LISP_OBJECT ("hash-table", hash_table, + mark_hash_table, print_hash_table, + 0, hash_table_equal, hash_table_hash, + hash_table_description, + Lisp_Hash_Table); #else /* not NEW_GC */ -DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table, - 1, /*dumpable-flag*/ - mark_hash_table, print_hash_table, - finalize_hash_table, - hash_table_equal, hash_table_hash, - hash_table_description, - Lisp_Hash_Table); +DEFINE_DUMPABLE_LISP_OBJECT ("hash-table", hash_table, + mark_hash_table, print_hash_table, + finalize_hash_table, + hash_table_equal, hash_table_hash, + hash_table_description, + Lisp_Hash_Table); #endif /* not NEW_GC */ static Lisp_Hash_Table * @@ -535,6 +528,17 @@ ((double) ht->size * (.6180339887 / (double) sizeof (Lisp_Object))); } +static htentry * +allocate_hash_table_entries (Elemcount size) +{ +#ifdef NEW_GC + return XHASH_TABLE_ENTRY (alloc_lrecord_array + (size, &lrecord_hash_table_entry)); +#else /* not NEW_GC */ + return xnew_array_and_zero (htentry, size); +#endif /* not NEW_GC */ +} + Lisp_Object make_standard_lisp_hash_table (enum hash_table_test test, Elemcount size, @@ -579,8 +583,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; @@ -602,15 +606,7 @@ compute_hash_table_derived_values (ht); /* We leave room for one never-occupied sentinel htentry at the end. */ -#ifdef NEW_GC - ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry), - ht->size + 1, - &lrecord_hash_table_entry); -#else /* not NEW_GC */ - ht->hentries = xnew_array_and_zero (htentry, ht->size + 1); -#endif /* not NEW_GC */ - - hash_table = wrap_hash_table (ht); + ht->hentries = allocate_hash_table_entries (ht->size + 1); if (weakness == HASH_TABLE_NON_WEAK) ht->next_weak = Qunbound; @@ -1041,27 +1037,21 @@ (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); - COPY_LCRECORD (ht, ht_old); + Lisp_Object obj = ALLOC_LISP_OBJECT (hash_table); + Lisp_Hash_Table *ht = XHASH_TABLE (obj); + COPY_LISP_OBJECT (ht, ht_old); -#ifdef NEW_GC - ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry), - ht_old->size + 1, - &lrecord_hash_table_entry); -#else /* not NEW_GC */ - ht->hentries = xnew_array (htentry, ht_old->size + 1); -#endif /* not NEW_GC */ + /* We leave room for one never-occupied sentinel htentry at the end. */ + ht->hentries = allocate_hash_table_entries (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 @@ -1075,13 +1065,8 @@ old_entries = ht->hentries; -#ifdef NEW_GC - ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry), - new_size + 1, - &lrecord_hash_table_entry); -#else /* not NEW_GC */ - ht->hentries = xnew_array_and_zero (htentry, new_size + 1); -#endif /* not NEW_GC */ + /* We leave room for one never-occupied sentinel htentry at the end. */ + ht->hentries = allocate_hash_table_entries (new_size + 1); new_entries = ht->hentries; compute_hash_table_derived_values (ht); @@ -1107,13 +1092,8 @@ pdump_reorganize_hash_table (Lisp_Object hash_table) { const Lisp_Hash_Table *ht = xhash_table (hash_table); -#ifdef NEW_GC - htentry *new_entries = - (htentry *) alloc_lrecord_array (sizeof (htentry), ht->size + 1, - &lrecord_hash_table_entry); -#else /* not NEW_GC */ - htentry *new_entries = xnew_array_and_zero (htentry, ht->size + 1); -#endif /* not NEW_GC */ + /* We leave room for one never-occupied sentinel htentry at the end. */ + htentry *new_entries = allocate_hash_table_entries (ht->size + 1); htentry *e, *sentinel; for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) @@ -1879,9 +1859,9 @@ void init_elhash_once_early (void) { - INIT_LRECORD_IMPLEMENTATION (hash_table); + INIT_LISP_OBJECT (hash_table); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (hash_table_entry); + INIT_LISP_OBJECT (hash_table_entry); #endif /* NEW_GC */ /* This must NOT be staticpro'd */
--- a/src/elhash.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/elhash.h Wed Feb 24 19:04:27 2010 -0600 @@ -25,7 +25,7 @@ typedef struct Lisp_Hash_Table Lisp_Hash_Table; -DECLARE_LRECORD (hash_table, Lisp_Hash_Table); +DECLARE_LISP_OBJECT (hash_table, Lisp_Hash_Table); #define XHASH_TABLE(x) XRECORD (x, hash_table, Lisp_Hash_Table) #define wrap_hash_table(p) wrap_record (p, hash_table) @@ -36,7 +36,7 @@ typedef struct htentry { #ifdef NEW_GC - struct lrecord_header lheader; + LISP_OBJECT_HEADER lheader; #endif /* NEW_GC */ Lisp_Object key; Lisp_Object value; @@ -48,7 +48,7 @@ typedef struct htentry Lisp_Hash_Table_Entry; -DECLARE_LRECORD (hash_table_entry, Lisp_Hash_Table_Entry); +DECLARE_LISP_OBJECT (hash_table_entry, Lisp_Hash_Table_Entry); #define XHASH_TABLE_ENTRY(x) \ XRECORD (x, hash_table_entry, Lisp_Hash_Table_Entry)
--- a/src/emacs.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/emacs.c Wed Feb 24 19:04:27 2010 -0600 @@ -1470,7 +1470,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() @@ -2021,8 +2021,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 Wed Feb 24 11:08:30 2010 +0100 +++ b/src/eval.c Wed Feb 24 19:04:27 2010 -0600 @@ -444,11 +444,10 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("subr", subr, - 1, /*dumpable-flag*/ - 0, print_subr, 0, 0, 0, - subr_description, - Lisp_Subr); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("subr", subr, + 0, print_subr, 0, 0, 0, + subr_description, + Lisp_Subr); /************************************************************************/ /* Entering the debugger */ @@ -4491,6 +4490,7 @@ Bytecount sizem; struct multiple_value *mv; Elemcount i, allocated_count; + Lisp_Object mvobj; assert (count != 1); @@ -4516,8 +4516,8 @@ sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (multiple_value, Lisp_Object, contents, allocated_count); - mv = (multiple_value *) BASIC_ALLOC_LCRECORD (sizem, - &lrecord_multiple_value); + mvobj = ALLOC_SIZED_LISP_OBJECT (sizem, multiple_value); + mv = XMULTIPLE_VALUE (mvobj); mv->count = count; mv->first_desired = first_desired; @@ -4529,7 +4529,7 @@ mv->contents[1 + (i - first_desired)] = Qunbound; } - return wrap_multiple_value (mv); + return mvobj; } void @@ -4640,15 +4640,14 @@ { XD_END } }; -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("multiple-value", multiple_value, - 1, /*dumpable-flag*/ - mark_multiple_value, - print_multiple_value, 0, - 0, /* No equal method. */ - 0, /* No hash method. */ - multiple_value_description, - size_multiple_value, - struct multiple_value); +DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("multiple-value", multiple_value, + mark_multiple_value, + print_multiple_value, 0, + 0, /* No equal method. */ + 0, /* No hash method. */ + multiple_value_description, + size_multiple_value, + struct multiple_value); /* Given that FIRST and UPPER are the inclusive lower and exclusive upper bounds for the multiple values we're interested in, modify (or don't) the @@ -7236,8 +7235,8 @@ void syms_of_eval (void) { - INIT_LRECORD_IMPLEMENTATION (subr); - INIT_LRECORD_IMPLEMENTATION (multiple_value); + INIT_LISP_OBJECT (subr); + INIT_LISP_OBJECT (multiple_value); DEFSYMBOL (Qinhibit_quit); DEFSYMBOL (Qautoload);
--- a/src/event-stream.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/event-stream.c Wed Feb 24 19:04:27 2010 -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, 2010 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002, 2003, 2005, 2010 Ben Wing. This file is part of XEmacs. @@ -330,10 +330,6 @@ #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder) #define CONCHECK_COMMAND_BUILDER(x) CONCHECK_RECORD (x, command_builder) -#ifndef NEW_GC -static Lisp_Object Vcommand_builder_free_list; -#endif /* not NEW_GC */ - 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) }, @@ -356,25 +352,22 @@ } static void -finalize_command_builder (void *header, int for_disksave) +finalize_command_builder (void *header) { - if (!for_disksave) + struct command_builder *b = (struct command_builder *) header; + if (b->echo_buf) { - struct command_builder *b = (struct command_builder *) header; - if (b->echo_buf) - { - xfree (b->echo_buf); - b->echo_buf = 0; - } + xfree (b->echo_buf); + b->echo_buf = 0; } } -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_NODUMP_LISP_OBJECT ("command-builder", command_builder, + mark_command_builder, + internal_object_printer, + finalize_command_builder, 0, 0, + command_builder_description, + struct command_builder); static void reset_command_builder_event_chain (struct command_builder *builder) @@ -389,13 +382,7 @@ Lisp_Object allocate_command_builder (Lisp_Object console, int with_echo_buf) { - Lisp_Object builder_obj = -#ifdef NEW_GC - wrap_pointer_1 (alloc_lrecord_type (struct command_builder, - &lrecord_command_builder)); -#else /* not NEW_GC */ - alloc_managed_lcrecord (Vcommand_builder_free_list); -#endif /* not NEW_GC */ + Lisp_Object builder_obj = ALLOC_LISP_OBJECT (command_builder); struct command_builder *builder = XCOMMAND_BUILDER (builder_obj); builder->console = console; @@ -466,12 +453,7 @@ xfree (builder->echo_buf); builder->echo_buf = NULL; } -#ifdef NEW_GC - free_lrecord (wrap_command_builder (builder)); -#else /* not NEW_GC */ - free_managed_lcrecord (Vcommand_builder_free_list, - wrap_command_builder (builder)); -#endif /* not NEW_GC */ + FREE_LISP_OBJECT (wrap_command_builder (builder)); } static void @@ -1035,10 +1017,6 @@ static Lisp_Object pending_timeout_list, pending_async_timeout_list; -#ifndef NEW_GC -static Lisp_Object Vtimeout_free_list; -#endif /* not NEW_GC */ - static Lisp_Object mark_timeout (Lisp_Object obj) { @@ -1053,10 +1031,9 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout, - 1, /*dumpable-flag*/ - mark_timeout, internal_object_printer, - 0, 0, 0, timeout_description, Lisp_Timeout); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("timeout", timeout, + mark_timeout, timeout_description, + Lisp_Timeout); /* Generate a timeout and return its ID. */ @@ -1066,12 +1043,7 @@ Lisp_Object function, Lisp_Object object, int async_p) { -#ifdef NEW_GC - Lisp_Object op = - wrap_pointer_1 (alloc_lrecord_type (Lisp_Timeout, &lrecord_timeout)); -#else /* not NEW_GC */ - Lisp_Object op = alloc_managed_lcrecord (Vtimeout_free_list); -#endif /* not NEW_GC */ + Lisp_Object op = ALLOC_LISP_OBJECT (timeout); Lisp_Timeout *timeout = XTIMEOUT (op); EMACS_TIME current_time; EMACS_TIME interval; @@ -1189,11 +1161,7 @@ *timeout_list = noseeum_cons (op, *timeout_list); } else -#ifdef NEW_GC - free_lrecord (op); -#else /* not NEW_GC */ - free_managed_lcrecord (Vtimeout_free_list, op); -#endif /* not NEW_GC */ + FREE_LISP_OBJECT (op); UNGCPRO; return id; @@ -1230,11 +1198,7 @@ signal_remove_async_interval_timeout (timeout->interval_id); else event_stream_remove_timeout (timeout->interval_id); -#ifdef NEW_GC - free_lrecord (op); -#else /* not NEW_GC */ - free_managed_lcrecord (Vtimeout_free_list, op); -#endif /* not NEW_GC */ + FREE_LISP_OBJECT (op); } } @@ -4875,8 +4839,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); @@ -4930,15 +4894,6 @@ recent_keys_ring_index = 0; recent_keys_ring_size = 100; num_input_chars = 0; -#ifndef NEW_GC - 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 NEW_GC */ the_low_level_timeout_blocktype = Blocktype_new (struct low_level_timeout_blocktype); something_happened = 0;
--- a/src/events.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/events.c Wed Feb 24 19:04:27 2010 -0600 @@ -212,59 +212,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_NODUMP_FROB_BLOCK_LISP_OBJECT ("key-data", key_data, + 0, internal_object_printer, 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_NODUMP_FROB_BLOCK_LISP_OBJECT ("button-data", button_data, + 0, internal_object_printer, 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_NODUMP_FROB_BLOCK_LISP_OBJECT ("motion-data", motion_data, + 0, internal_object_printer, 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_NODUMP_FROB_BLOCK_LISP_OBJECT ("process-data", process_data, + 0, internal_object_printer, 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_NODUMP_FROB_BLOCK_LISP_OBJECT ("timeout-data", timeout_data, + 0, internal_object_printer, 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_NODUMP_FROB_BLOCK_LISP_OBJECT ("eval-data", eval_data, + 0, internal_object_printer, 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_NODUMP_FROB_BLOCK_LISP_OBJECT ("misc-user-data", misc_user_data, + 0, internal_object_printer, 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_NODUMP_FROB_BLOCK_LISP_OBJECT ("magic-eval-data", magic_eval_data, + 0, internal_object_printer, 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_NODUMP_FROB_BLOCK_LISP_OBJECT ("magic-data", magic_data, + 0, internal_object_printer, 0, 0, 0, + magic_data_description, + Lisp_Magic_Data); #endif /* EVENT_DATA_AS_OBJECTS */ @@ -507,11 +498,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_NODUMP_FROB_BLOCK_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. @@ -2556,17 +2547,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/events.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/events.h Wed Feb 24 19:04:27 2010 -0600 @@ -123,7 +123,7 @@ struct Lisp_Key_Data { #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ /* What keysym this is; a character or a symbol. */ Lisp_Object keysym; @@ -186,7 +186,7 @@ #define SET_KEY_DATA_MODIFIERS(d, m) ((d)->modifiers = m) #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (key_data, Lisp_Key_Data); +DECLARE_LISP_OBJECT (key_data, Lisp_Key_Data); #define XKEY_DATA(x) XRECORD (x, key_data, Lisp_Key_Data) #define wrap_key_data(p) wrap_record (p, key_data) #define KEY_DATAP(x) RECORDP (x, key_data) @@ -219,7 +219,7 @@ struct Lisp_Button_Data { #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ /* What button went down or up. */ int button; @@ -232,7 +232,7 @@ typedef struct Lisp_Button_Data Lisp_Button_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (button_data, Lisp_Button_Data); +DECLARE_LISP_OBJECT (button_data, Lisp_Button_Data); #define XBUTTON_DATA(x) XRECORD (x, button_data, Lisp_Button_Data) #define wrap_button_data(p) wrap_record (p, button_data) #define BUTTON_DATAP(x) RECORDP (x, button_data) @@ -271,7 +271,7 @@ struct Lisp_Motion_Data { #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ /* Where it was after it moved (in pixels). */ int x, y; @@ -281,7 +281,7 @@ typedef struct Lisp_Motion_Data Lisp_Motion_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (motion_data, Lisp_Motion_Data); +DECLARE_LISP_OBJECT (motion_data, Lisp_Motion_Data); #define XMOTION_DATA(x) XRECORD (x, motion_data, Lisp_Motion_Data) #define wrap_motion_data(p) wrap_record (p, motion_data) #define MOTION_DATAP(x) RECORDP (x, motion_data) @@ -313,7 +313,7 @@ struct Lisp_Process_Data { #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ /* the XEmacs "process" object in question */ Lisp_Object process; @@ -321,7 +321,7 @@ typedef struct Lisp_Process_Data Lisp_Process_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (process_data, Lisp_Process_Data); +DECLARE_LISP_OBJECT (process_data, Lisp_Process_Data); #define XPROCESS_DATA(x) XRECORD (x, process_data, Lisp_Process_Data) #define wrap_process_data(p) wrap_record (p, process_data) #define PROCESS_DATAP(x) RECORDP (x, process_data) @@ -352,7 +352,7 @@ object The object passed to that function. */ #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ int interval_id; int id_number; @@ -362,7 +362,7 @@ typedef struct Lisp_Timeout_Data Lisp_Timeout_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (timeout_data, Lisp_Timeout_Data); +DECLARE_LISP_OBJECT (timeout_data, Lisp_Timeout_Data); #define XTIMEOUT_DATA(x) XRECORD (x, timeout_data, Lisp_Timeout_Data) #define wrap_timeout_data(p) wrap_record(p, timeout_data) #define TIMEOUT_DATAP(x) RECORDP (x, timeout_data) @@ -411,7 +411,7 @@ object Argument of function. */ #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ Lisp_Object function; Lisp_Object object; @@ -419,7 +419,7 @@ typedef struct Lisp_Eval_Data Lisp_Eval_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (eval_data, Lisp_Eval_Data); +DECLARE_LISP_OBJECT (eval_data, Lisp_Eval_Data); #define XEVAL_DATA(x) XRECORD (x, eval_data, Lisp_Eval_Data) #define wrap_eval_data(p) wrap_record(p, eval_data) #define EVAL_DATAP(x) RECORDP (x, eval_data) @@ -464,7 +464,7 @@ values for other types of misc_user_events. */ #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ Lisp_Object function; Lisp_Object object; @@ -475,7 +475,7 @@ typedef struct Lisp_Misc_User_Data Lisp_Misc_User_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (misc_user_data, Lisp_Misc_User_Data); +DECLARE_LISP_OBJECT (misc_user_data, Lisp_Misc_User_Data); #define XMISC_USER_DATA(x) XRECORD (x, misc_user_data, Lisp_Misc_User_Data) #define wrap_misc_user_data(p) wrap_record(p, misc_user_data) #define MISC_USER_DATAP(x) RECORDP (x, misc_user_data) @@ -541,7 +541,7 @@ */ #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ void (*internal_function) (Lisp_Object); Lisp_Object object; @@ -549,7 +549,7 @@ typedef struct Lisp_Magic_Eval_Data Lisp_Magic_Eval_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (magic_eval_data, Lisp_Magic_Eval_Data); +DECLARE_LISP_OBJECT (magic_eval_data, Lisp_Magic_Eval_Data); #define XMAGIC_EVAL_DATA(x) XRECORD (x, magic_eval_data, Lisp_Magic_Eval_Data) #define wrap_magic_eval_data(p) wrap_record(p, magic_eval_data) #define MAGIC_EVAL_DATAP(x) RECORDP (x, magic_eval_data) @@ -597,7 +597,7 @@ */ #ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; #endif /* EVENT_DATA_AS_OBJECTS */ union { @@ -616,7 +616,7 @@ typedef struct Lisp_Magic_Data Lisp_Magic_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (magic_data, Lisp_Magic_Data); +DECLARE_LISP_OBJECT (magic_data, Lisp_Magic_Data); #define XMAGIC_DATA(x) XRECORD (x, magic_data, Lisp_Magic_Data) #define wrap_magic_data(p) wrap_record(p, magic_data) #define MAGIC_DATAP(x) RECORDP (x, magic_data) @@ -660,7 +660,7 @@ struct Lisp_Timeout { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; int id; /* Id we use to identify the timeout over its lifetime */ int interval_id; /* Id for this particular interval; this may be different each time the timeout is @@ -675,7 +675,7 @@ }; typedef struct Lisp_Timeout Lisp_Timeout; -DECLARE_LRECORD (timeout, Lisp_Timeout); +DECLARE_LISP_OBJECT (timeout, Lisp_Timeout); #define XTIMEOUT(x) XRECORD (x, timeout, Lisp_Timeout) #define wrap_timeout(p) wrap_record (p, timeout) #define TIMEOUTP(x) RECORDP (x, timeout) @@ -690,7 +690,7 @@ - Likewise for events chained in the command builder. - Otherwise it's Qnil. */ - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; Lisp_Object next; emacs_event_type event_type; @@ -747,14 +747,14 @@ #endif /* not EVENT_DATA_AS_OBJECTS */ }; -DECLARE_LRECORD (event, Lisp_Event); +DECLARE_LISP_OBJECT (event, Lisp_Event); #define XEVENT(x) XRECORD (x, event, Lisp_Event) #define wrap_event(p) wrap_record (p, event) #define EVENTP(x) RECORDP (x, event) #define CHECK_EVENT(x) CHECK_RECORD (x, event) #define CONCHECK_EVENT(x) CONCHECK_RECORD (x, event) -DECLARE_LRECORD (command_builder, struct command_builder); +DECLARE_LISP_OBJECT (command_builder, struct command_builder); #define EVENT_CHANNEL(a) ((a)->channel) #define XEVENT_CHANNEL(ev) (XEVENT (ev)->channel) @@ -1117,7 +1117,7 @@ */ struct command_builder { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object console; /* back pointer to the console this command builder is for */ #if 0
--- a/src/extents-impl.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/extents-impl.h Wed Feb 24 19:04:27 2010 -0600 @@ -27,7 +27,7 @@ struct extent { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; Memxpos start; Memxpos end; @@ -103,7 +103,7 @@ typedef struct extent_auxiliary extent_auxiliary; struct extent_auxiliary { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object begin_glyph; Lisp_Object end_glyph; @@ -129,7 +129,7 @@ struct extent_info { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; struct extent_list *extents; struct stack_of_extents *soe;
--- a/src/extents.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/extents.c Wed Feb 24 19:04:27 2010 -0600 @@ -243,7 +243,7 @@ typedef struct gap_array_marker { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ int pos; struct gap_array_marker *next; @@ -273,7 +273,7 @@ typedef struct gap_array { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Elemcount gap; Elemcount gapsize; @@ -319,7 +319,7 @@ typedef struct extent_list_marker { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Gap_Array_Marker *m; int endp; @@ -329,7 +329,7 @@ typedef struct extent_list { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Gap_Array *start; Gap_Array *end; @@ -394,7 +394,7 @@ typedef struct stack_of_extents { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Extent_List *extents; Memxpos pos; /* Position of stack of extents. EXTENTS is the list of @@ -691,7 +691,7 @@ assert (pos >= 0 && pos <= ga->numels); #ifdef NEW_GC - m = alloc_lrecord_type (Gap_Array_Marker, &lrecord_gap_array_marker); + m = XGAP_ARRAY_MARKER (ALLOC_LISP_OBJECT (gap_array_marker)); #else /* not NEW_GC */ if (gap_array_marker_freelist) { @@ -757,7 +757,8 @@ make_gap_array (Elemcount elsize) { #ifdef NEW_GC - Gap_Array *ga = alloc_lrecord_type (Gap_Array, &lrecord_gap_array); + Gap_Array *ga = XGAP_ARRAY (ALLOC_SIZED_LISP_OBJECT (sizeof (Gap_Array), + gap_array)); #else /* not NEW_GC */ Gap_Array *ga = xnew_and_zero (Gap_Array); #endif /* not NEW_GC */ @@ -928,7 +929,7 @@ Extent_List_Marker *m; #ifdef NEW_GC - m = alloc_lrecord_type (Extent_List_Marker, &lrecord_extent_list_marker); + m = XEXTENT_LIST_MARKER (ALLOC_LISP_OBJECT (extent_list_marker)); #else /* not NEW_GC */ if (extent_list_marker_freelist) { @@ -977,7 +978,7 @@ allocate_extent_list (void) { #ifdef NEW_GC - Extent_List *el = alloc_lrecord_type (Extent_List, &lrecord_extent_list); + Extent_List *el = XEXTENT_LIST (ALLOC_LISP_OBJECT (extent_list)); #else /* not NEW_GC */ Extent_List *el = xnew (Extent_List); #endif /* not NEW_GC */ @@ -1031,20 +1032,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_NODUMP_INTERNAL_LISP_OBJECT ("extent-auxiliary", + extent_auxiliary, + mark_extent_auxiliary, + extent_auxiliary_description, + struct 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); - COPY_LCRECORD (data, &extent_auxiliary_defaults); - extent_aux = wrap_extent_auxiliary (data); - ext->plist = Fcons (extent_aux, ext->plist); + Lisp_Object obj = ALLOC_LISP_OBJECT (extent_auxiliary); + struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj); + + COPY_LISP_OBJECT (data, &extent_auxiliary_defaults); + ext->plist = Fcons (obj, ext->plist); ext->flags.has_aux = 1; } @@ -1093,11 +1093,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("gap-array-marker", gap_array_marker, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - gap_array_marker_description_1, - struct gap_array_marker); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("gap-array-marker", gap_array_marker, + 0, gap_array_marker_description_1, + struct gap_array_marker); #else /* not NEW_GC */ const struct sized_memory_description gap_array_marker_description = { sizeof (Gap_Array_Marker), @@ -1131,12 +1129,11 @@ return offsetof (Gap_Array, array) + (ga->numels + ga->gapsize) * ga->elsize; } -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("gap-array", gap_array, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - lispobj_gap_array_description_1, - size_gap_array, - struct gap_array); +DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT ("gap-array", gap_array, + 0, + lispobj_gap_array_description_1, + size_gap_array, + struct gap_array); #else /* not NEW_GC */ static const struct sized_memory_description lispobj_gap_array_description = { sizeof (Gap_Array), @@ -1160,11 +1157,10 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("extent-list-marker", extent_list_marker, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - extent_list_marker_description_1, - struct extent_list_marker); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("extent-list-marker", + extent_list_marker, + 0, extent_list_marker_description_1, + struct extent_list_marker); #else /* not NEW_GC */ const struct sized_memory_description extent_list_marker_description = { sizeof (Extent_List_Marker), @@ -1189,11 +1185,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("extent-list", extent_list, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - extent_list_description_1, - struct extent_list); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("extent-list", extent_list, + 0, extent_list_description_1, + struct extent_list); #else /* not NEW_GC */ static const struct sized_memory_description extent_list_description = { sizeof (Extent_List), @@ -1212,11 +1206,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("stack-of-extents", stack_of_extents, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - stack_of_extents_description_1, - struct stack_of_extents); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("stack-of-extents", stack_of_extents, + 0, stack_of_extents_description_1, + struct stack_of_extents); #else /* not NEW_GC */ static const struct sized_memory_description stack_of_extents_description = { sizeof (Stack_Of_Extents), @@ -1268,21 +1260,16 @@ } #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info, - 0, /*dumpable-flag*/ - mark_extent_info, internal_object_printer, - 0, 0, 0, - extent_info_description, - struct extent_info); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("extent-info", extent_info, + mark_extent_info, + extent_info_description, + struct extent_info); #else /* not NEW_GC */ static void -finalize_extent_info (void *header, int for_disksave) +finalize_extent_info (void *header) { struct extent_info *data = (struct extent_info *) header; - if (for_disksave) - return; - data->soe = 0; data->extents = 0; if (data->soe) @@ -1297,25 +1284,22 @@ } } -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_NODUMP_LISP_OBJECT ("extent-info", extent_info, + mark_extent_info, internal_object_printer, + finalize_extent_info, 0, 0, + extent_info_description, + struct extent_info); #endif /* not NEW_GC */ 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 @@ -1480,7 +1464,7 @@ extents pointing to the extents. */ detach_all_extents (wrap_buffer (b)); #ifndef NEW_GC - finalize_extent_info (data, 0); + finalize_extent_info (data); #endif /* not NEW_GC */ } @@ -1800,8 +1784,8 @@ allocate_soe (void) { #ifdef NEW_GC - struct stack_of_extents *soe = - alloc_lrecord_type (struct stack_of_extents, &lrecord_stack_of_extents); + struct stack_of_extents *soe = + XSTACK_OF_EXTENTS (ALLOC_LISP_OBJECT (stack_of_extents)); #else /* not NEW_GC */ struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents); #endif /* not NEW_GC */ @@ -3479,8 +3463,7 @@ return Fextent_properties (obj); } -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent, - 1, /*dumpable-flag*/ +DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT ("extent", extent, mark_extent, print_extent, /* NOTE: If you declare a @@ -3492,6 +3475,7 @@ extent_description, extent_getprop, extent_putprop, extent_remprop, extent_plist, + 0 /* no disksaver */, struct extent); /************************************************************************/ @@ -4059,12 +4043,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); - - COPY_LCRECORD (data, XEXTENT_AUXILIARY (XCAR (original->plist))); - XCAR (e->plist) = wrap_extent_auxiliary (data); + Lisp_Object ea = ALLOC_LISP_OBJECT (extent_auxiliary); + struct extent_auxiliary *data = XEXTENT_AUXILIARY (ea); + + COPY_LISP_OBJECT (data, XEXTENT_AUXILIARY (XCAR (original->plist))); + XCAR (e->plist) = ea; } { @@ -7454,15 +7437,15 @@ 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); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (gap_array_marker); - INIT_LRECORD_IMPLEMENTATION (gap_array); - INIT_LRECORD_IMPLEMENTATION (extent_list_marker); - INIT_LRECORD_IMPLEMENTATION (extent_list); - INIT_LRECORD_IMPLEMENTATION (stack_of_extents); + INIT_LISP_OBJECT (gap_array_marker); + INIT_LISP_OBJECT (gap_array); + INIT_LISP_OBJECT (extent_list_marker); + INIT_LISP_OBJECT (extent_list); + INIT_LISP_OBJECT (stack_of_extents); #endif /* NEW_GC */ DEFSYMBOL (Qextentp);
--- a/src/extents.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/extents.h Wed Feb 24 19:04:27 2010 -0600 @@ -23,7 +23,7 @@ #ifndef INCLUDED_extents_h_ #define INCLUDED_extents_h_ -DECLARE_LRECORD (extent, struct extent); +DECLARE_LISP_OBJECT (extent, struct extent); #define XEXTENT(x) XRECORD (x, extent, struct extent) #define wrap_extent(p) wrap_record (p, extent) #define EXTENTP(x) RECORDP (x, extent) @@ -32,7 +32,7 @@ struct extent_auxiliary; -DECLARE_LRECORD (extent_auxiliary, struct extent_auxiliary); +DECLARE_LISP_OBJECT (extent_auxiliary, struct extent_auxiliary); #define XEXTENT_AUXILIARY(x) \ XRECORD (x, extent_auxiliary, struct extent_auxiliary) #define wrap_extent_auxiliary(p) wrap_record (p, extent_auxiliary) @@ -42,7 +42,7 @@ struct extent_info; -DECLARE_LRECORD (extent_info, struct extent_info); +DECLARE_LISP_OBJECT (extent_info, struct extent_info); #define XEXTENT_INFO(x) XRECORD (x, extent_info, struct extent_info) #define wrap_extent_info(p) wrap_record (p, extent_info) #define EXTENT_INFOP(x) RECORDP (x, extent_info) @@ -52,7 +52,7 @@ #ifdef NEW_GC struct gap_array_marker; -DECLARE_LRECORD (gap_array_marker, struct gap_array_marker); +DECLARE_LISP_OBJECT (gap_array_marker, struct gap_array_marker); #define XGAP_ARRAY_MARKER(x) \ XRECORD (x, gap_array_marker, struct gap_array_marker) #define wrap_gap_array_marker(p) wrap_record (p, gap_array_marker) @@ -62,7 +62,7 @@ struct gap_array; -DECLARE_LRECORD (gap_array, struct gap_array); +DECLARE_LISP_OBJECT (gap_array, struct gap_array); #define XGAP_ARRAY(x) XRECORD (x, gap_array, struct gap_array) #define wrap_gap_array(p) wrap_record (p, gap_array) #define GAP_ARRAYP(x) RECORDP (x, gap_array) @@ -71,7 +71,7 @@ struct extent_list_marker; -DECLARE_LRECORD (extent_list_marker, struct extent_list_marker); +DECLARE_LISP_OBJECT (extent_list_marker, struct extent_list_marker); #define XEXTENT_LIST_MARKER(x) \ XRECORD (x, extent_list_marker, struct extent_list_marker) #define wrap_extent_list_marker(p) wrap_record (p, extent_list_marker) @@ -81,7 +81,7 @@ struct extent_list; -DECLARE_LRECORD (extent_list, struct extent_list); +DECLARE_LISP_OBJECT (extent_list, struct extent_list); #define XEXTENT_LIST(x) XRECORD (x, extent_list, struct extent_list) #define wrap_extent_list(p) wrap_record (p, extent_list) #define EXTENT_LISTP(x) RECORDP (x, extent_list) @@ -90,7 +90,7 @@ struct stack_of_extents; -DECLARE_LRECORD (stack_of_extents, struct stack_of_extents); +DECLARE_LISP_OBJECT (stack_of_extents, struct stack_of_extents); #define XSTACK_OF_EXTENTS(x) \ XRECORD (x, stack_of_extents, struct stack_of_extents) #define wrap_stack_of_extents(p) wrap_record (p, stack_of_extents)
--- a/src/faces.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/faces.c Wed Feb 24 19:04:27 2010 -0600 @@ -304,13 +304,13 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face, - 1, /*dumpable-flag*/ - mark_face, print_face, 0, face_equal, - face_hash, face_description, - face_getprop, - face_putprop, face_remprop, - face_plist, Lisp_Face); +DEFINE_DUMPABLE_GENERAL_LISP_OBJECT ("face", face, + mark_face, print_face, 0, face_equal, + face_hash, face_description, + face_getprop, + face_putprop, face_remprop, + face_plist, 0 /* no disksaver */, + Lisp_Face); /************************************************************************/ /* face read syntax */ @@ -399,7 +399,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; @@ -2090,7 +2091,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/faces.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/faces.h Wed Feb 24 19:04:27 2010 -0600 @@ -34,7 +34,7 @@ struct Lisp_Face { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object name; Lisp_Object doc_string; @@ -119,7 +119,7 @@ struct face_cachel { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ /* There are two kinds of cachels; those created from a single face and those created by merging more than one face. In the former @@ -236,7 +236,7 @@ #ifdef NEW_GC typedef struct face_cachel Lisp_Face_Cachel; -DECLARE_LRECORD (face_cachel, Lisp_Face_Cachel); +DECLARE_LISP_OBJECT (face_cachel, Lisp_Face_Cachel); #define XFACE_CACHEL(x) \ XRECORD (x, face_cachel, Lisp_Face_Cachel) @@ -246,7 +246,7 @@ #define CONCHECK_FACE_CACHEL(x) CONCHECK_RECORD (x, face_cachel) #endif /* NEW_GC */ -DECLARE_LRECORD (face, Lisp_Face); +DECLARE_LISP_OBJECT (face, Lisp_Face); #define XFACE(x) XRECORD (x, face, Lisp_Face) #define wrap_face(p) wrap_record (p, face) #define FACEP(x) RECORDP (x, face)
--- a/src/file-coding.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/file-coding.c Wed Feb 24 19:04:27 2010 -0600 @@ -318,14 +318,13 @@ #ifndef NEW_GC static void -finalize_coding_system (void *header, int for_disksave) +finalize_coding_system (void *header) { Lisp_Object cs = wrap_coding_system ((Lisp_Coding_System *) header); /* Since coding systems never go away, this function is not necessary. But it would be necessary if we changed things so that coding systems could go away. */ - if (!for_disksave) /* see comment in lstream.c */ - MAYBE_XCODESYSMETH (cs, finalize, (cs)); + MAYBE_XCODESYSMETH (cs, finalize, (cs)); } #endif /* not NEW_GC */ @@ -380,22 +379,20 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("coding-system", coding_system, - 1, /*dumpable-flag*/ - mark_coding_system, - print_coding_system, - 0, 0, 0, coding_system_description, - sizeof_coding_system, - Lisp_Coding_System); +DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("coding-system", coding_system, + mark_coding_system, + print_coding_system, + 0, 0, 0, coding_system_description, + sizeof_coding_system, + Lisp_Coding_System); #else /* not NEW_GC */ -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_DUMPABLE_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); #endif /* not NEW_GC */ /************************************************************************/ @@ -1005,9 +1002,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; @@ -1455,7 +1451,7 @@ { Lisp_Coding_System *to = XCODING_SYSTEM (new_coding_system); Lisp_Coding_System *from = XCODING_SYSTEM (old_coding_system); - COPY_SIZED_LCRECORD (to, from, sizeof_coding_system (from)); + COPY_SIZED_LISP_OBJECT (to, from, sizeof_coding_system (from)); to->name = new_name; } return new_coding_system; @@ -4508,7 +4504,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/file-coding.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/file-coding.h Wed Feb 24 19:04:27 2010 -0600 @@ -188,7 +188,7 @@ struct Lisp_Coding_System { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; struct coding_system_methods *methods; #define CODING_SYSTEM_SLOT_DECLARATION @@ -208,7 +208,7 @@ }; typedef struct Lisp_Coding_System Lisp_Coding_System; -DECLARE_LRECORD (coding_system, Lisp_Coding_System); +DECLARE_LISP_OBJECT (coding_system, Lisp_Coding_System); #define XCODING_SYSTEM(x) XRECORD (x, coding_system, Lisp_Coding_System) #define wrap_coding_system(p) wrap_record (p, coding_system) #define CODING_SYSTEMP(x) RECORDP (x, coding_system) @@ -363,14 +363,13 @@ stick around until GC time. (File handles can also be closed when EOF is signalled; but some data must stick around after this point, for the benefit of canonicalize_after_coding. See the convert method.) - Called only once (NOT called at disksave time). Optional. */ + Called only once. Optional. */ void (*finalize_coding_stream_method) (struct coding_stream *str); /* Finalize method: Clean up type-specific data (e.g. free allocated data) attached to the coding system (i.e. in struct TYPE_coding_system), when the coding system is about to be garbage - collected. (Currently not called.) Called only once (NOT called at - disksave time). Optional. */ + collected. (Currently not called.) Called only once. Optional. */ void (*finalize_method) (Lisp_Object codesys); /* Conversion end type method: Does this coding system encode bytes -> @@ -807,8 +806,7 @@ void (*detect_method) (struct detection_state *st, const unsigned char *src, Bytecount n); /* Finalize detection state method: Clean up any allocated data in the - detection state. Called only once (NOT called at disksave time). - Optional. */ + detection state. Called only once. Optional. */ void (*finalize_detection_state_method) (struct detection_state *st); };
--- a/src/floatfns.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/floatfns.c Wed Feb 24 19:04:27 2010 -0600 @@ -194,11 +194,10 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("float", float, - 1, /*dumpable-flag*/ - mark_float, print_float, 0, float_equal, - float_hash, float_description, - Lisp_Float); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("float", float, + mark_float, print_float, 0, + float_equal, float_hash, + float_description, Lisp_Float); /* Extract a Lisp number as a `double', or signal an error. */ @@ -2483,7 +2482,7 @@ void syms_of_floatfns (void) { - INIT_LRECORD_IMPLEMENTATION (float); + INIT_LISP_OBJECT (float); /* Trig functions. */
--- a/src/fns.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/fns.c Wed Feb 24 19:04:27 2010 -0600 @@ -131,15 +131,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_DUMPABLE_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, /* @@ -4766,7 +4765,7 @@ void syms_of_fns (void) { - INIT_LRECORD_IMPLEMENTATION (bit_vector); + INIT_LISP_OBJECT (bit_vector); DEFSYMBOL (Qstring_lessp); DEFSYMBOL (Qidentity);
--- a/src/font-mgr.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/font-mgr.c Wed Feb 24 19:04:27 2010 -0600 @@ -93,7 +93,7 @@ ****************************************************************/ static void -finalize_fc_pattern (void *header, int UNUSED (for_disksave)) +finalize_fc_pattern (void *header) { struct fc_pattern *p = (struct fc_pattern *) header; if (p->fcpatPtr) @@ -142,10 +142,10 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION("fc-pattern", fc_pattern, 0, - 0, print_fc_pattern, finalize_fc_pattern, - 0, 0, fcpattern_description, - struct fc_pattern); +DEFINE_NODUMP_LISP_OBJECT ("fc-pattern", fc_pattern, + 0, print_fc_pattern, finalize_fc_pattern, + 0, 0, fcpattern_description, + struct fc_pattern); /* * Helper Functions @@ -234,11 +234,10 @@ */ ()) { - fc_pattern *fcpat = - ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); + fc_pattern *fcpat = XFCPATTERN (ALLOC_LISP_OBJECT (fc_pattern)); - fcpat->fcpatPtr = FcPatternCreate(); - return wrap_fcpattern(fcpat); + fcpat->fcpatPtr = FcPatternCreate (); + return wrap_fcpattern (fcpat); } DEFUN("fc-name-parse", Ffc_name_parse, 1, 1, 0, /* @@ -246,13 +245,12 @@ */ (name)) { - struct fc_pattern *fcpat = - ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); + fc_pattern *fcpat = XFCPATTERN (ALLOC_LISP_OBJECT (fc_pattern)); - CHECK_STRING(name); + CHECK_STRING (name); fcpat->fcpatPtr = FcNameParse ((FcChar8 *) extract_fcapi_string (name)); - return wrap_fcpattern(fcpat); + return wrap_fcpattern (fcpat); } /* #### Ga-a-ack! Xft's similar function is actually a different API. @@ -277,11 +275,11 @@ (pattern)) { struct fc_pattern *copy = NULL; - CHECK_FCPATTERN(pattern); + CHECK_FCPATTERN (pattern); - copy = ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); - copy->fcpatPtr = FcPatternDuplicate(XFCPATTERN_PTR(pattern)); - return wrap_fcpattern(copy); + copy = XFCPATTERN (ALLOC_LISP_OBJECT (fc_pattern)); + copy->fcpatPtr = FcPatternDuplicate (XFCPATTERN_PTR (pattern)); + return wrap_fcpattern (copy); } DEFUN("fc-pattern-add", Ffc_pattern_add, 3, 3, 0, /* @@ -297,8 +295,8 @@ const Extbyte *obj; FcPattern *fcpat; - CHECK_FCPATTERN(pattern); - CHECK_STRING(property); + CHECK_FCPATTERN (pattern); + CHECK_STRING (property); obj = fc_intern (property); fcpat = XFCPATTERN_PTR (pattern); @@ -522,8 +520,7 @@ } { - fc_config *fccfg = - ALLOC_LCRECORD_TYPE (struct fc_config, &lrecord_fc_config); + fc_config *fccfg = XFCCONFIG (ALLOC_LISP_OBJECT (fc_config)); fccfg->fccfgPtr = fc; configs = Fcons (wrap_fcconfig (fccfg), configs); XWEAK_LIST_LIST (Vfc_config_weak_list) = configs; @@ -562,8 +559,7 @@ invalid_state ("failed to create FcFontSet", Qunbound); for (idx = 0; idx < fontset->nfont; ++idx) { - fcpat = - ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); + fcpat = XFCPATTERN (ALLOC_LISP_OBJECT (fc_pattern)); fcpat->fcpatPtr = FcPatternDuplicate (fontset->fonts[idx]); fontlist = Fcons (wrap_fcpattern(fcpat), fontlist); } @@ -994,7 +990,7 @@ if (!NILP (config)) CHECK_FCCONFIG (config); - res_fcpat = ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern); + res_fcpat = XFCPATTERN (ALLOC_LISP_OBJECT (fc_pattern)); p = XFCPATTERN_PTR(pattern); fcc = NILP (config) ? FcConfigGetCurrent () : XFCCONFIG_PTR (config); @@ -1096,7 +1092,7 @@ */ static void -finalize_fc_config (void *header, int UNUSED (for_disksave)) +finalize_fc_config (void *header) { struct fc_config *p = (struct fc_config *) header; if (p->fccfgPtr && p->fccfgPtr != FcConfigGetCurrent()) @@ -1124,10 +1120,10 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION("fc-config", fc_config, 0, - 0, print_fc_config, finalize_fc_config, 0, 0, - fcconfig_description, - struct fc_config); +DEFINE_NODUMP_LISP_OBJECT ("fc-config", fc_config, + 0, print_fc_config, finalize_fc_config, 0, 0, + fcconfig_description, + struct fc_config); DEFUN("fc-init", Ffc_init, 0, 0, 0, /* -- Function: FcBool FcInit (void) @@ -1299,7 +1295,7 @@ void syms_of_font_mgr (void) { - INIT_LRECORD_IMPLEMENTATION(fc_pattern); + INIT_LISP_OBJECT(fc_pattern); DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_patternp); @@ -1328,7 +1324,7 @@ DEFSUBR(Fxlfd_font_name_p); #ifdef FONTCONFIG_EXPOSE_CONFIG - INIT_LRECORD_IMPLEMENTATION(fc_config); + INIT_LISP_OBJECT(fc_config); DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_configp);
--- a/src/font-mgr.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/font-mgr.h Wed Feb 24 19:04:27 2010 -0600 @@ -54,13 +54,13 @@ struct fc_pattern { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; FcPattern *fcpatPtr; }; typedef struct fc_pattern fc_pattern; -DECLARE_LRECORD(fc_pattern, struct fc_pattern); +DECLARE_LISP_OBJECT(fc_pattern, struct fc_pattern); #define XFCPATTERN(x) XRECORD (x, fc_pattern, struct fc_pattern) #define wrap_fcpattern(p) wrap_record (p, fc_pattern) #define FCPATTERNP(x) RECORDP (x, fc_pattern) @@ -73,13 +73,13 @@ struct fc_config { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; FcConfig *fccfgPtr; }; typedef struct fc_config fc_config; -DECLARE_LRECORD(fc_config, struct fc_config); +DECLARE_LISP_OBJECT(fc_config, struct fc_config); #define XFCCONFIG(x) XRECORD (x, fc_config, struct fc_config) #define wrap_fcconfig(p) wrap_record (p, fc_config) #define FCCONFIGP(x) RECORDP (x, fc_config)
--- a/src/frame-gtk.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/frame-gtk.c Wed Feb 24 19:04:27 2010 -0600 @@ -103,11 +103,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("gtk-frame", gtk_frame, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - gtk_frame_data_description_1, - Lisp_Gtk_Frame); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("gtk-frame", gtk_frame, + 0, gtk_frame_data_description_1, + Lisp_Gtk_Frame); #else /* not NEW_GC */ extern const struct sized_memory_description gtk_frame_data_description; @@ -974,7 +972,7 @@ /* zero out all slots. */ #ifdef NEW_GC - f->frame_data = alloc_lrecord_type (struct gtk_frame, &lrecord_gtk_frame); + f->frame_data = XGTK_FRAME (ALLOC_LISP_OBJECT (gtk_frame)); #else /* not NEW_GC */ f->frame_data = xnew_and_zero (struct gtk_frame); #endif /* not NEW_GC */ @@ -1475,7 +1473,7 @@ syms_of_frame_gtk (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (gtk_frame); + INIT_LISP_OBJECT (gtk_frame); #endif /* NEW_GC */ DEFSYMBOL (Qtext_widget);
--- a/src/frame-impl.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/frame-impl.h Wed Feb 24 19:04:27 2010 -0600 @@ -41,7 +41,7 @@ struct frame { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; /* Methods for this frame's console. This can also be retrieved through frame->device->console, but it's faster this way. */
--- a/src/frame-msw.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/frame-msw.c Wed Feb 24 19:04:27 2010 -0600 @@ -93,11 +93,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("mswindows-frame", mswindows_frame, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - mswindows_frame_data_description_1, - Lisp_Mswindows_Frame); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("mswindows-frame", mswindows_frame, + 0, mswindows_frame_data_description_1, + Lisp_Mswindows_Frame); #else /* not NEW_GC */ extern const struct sized_memory_description mswindows_frame_data_description; @@ -174,8 +172,7 @@ CHECK_INT (height); #ifdef NEW_GC - f->frame_data = alloc_lrecord_type (struct mswindows_frame, - &lrecord_mswindows_frame); + f->frame_data = XMSWINDOWS_FRAME (ALLOC_LISP_OBJECT (mswindows_frame)); #else /* not NEW_GC */ f->frame_data = xnew_and_zero (struct mswindows_frame); #endif /* not NEW_GC */ @@ -1212,7 +1209,7 @@ syms_of_frame_mswindows (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (mswindows_frame); + INIT_LISP_OBJECT (mswindows_frame); #endif /* NEW_GC */ }
--- a/src/frame-x.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/frame-x.c Wed Feb 24 19:04:27 2010 -0600 @@ -74,11 +74,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("x-frame", x_frame, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - x_frame_data_description_1, - Lisp_X_Frame); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("x-frame", x_frame, + 0, x_frame_data_description_1, + Lisp_X_Frame); #else /* not NEW_GC */ extern const struct sized_memory_description x_frame_data_description; @@ -2035,7 +2033,7 @@ { /* zero out all slots. */ #ifdef NEW_GC - f->frame_data = alloc_lrecord_type (struct x_frame, &lrecord_x_frame); + f->frame_data = XX_FRAME (ALLOC_LISP_OBJECT (x_frame)); #else /* not NEW_GC */ f->frame_data = xnew_and_zero (struct x_frame); #endif /* not NEW_GC */ @@ -2748,7 +2746,7 @@ syms_of_frame_x (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (x_frame); + INIT_LISP_OBJECT (x_frame); #endif /* NEW_GC */ DEFSYMBOL (Qoverride_redirect);
--- a/src/frame.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/frame.c Wed Feb 24 19:04:27 2010 -0600 @@ -481,12 +481,9 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("expose-ignore", - expose_ignore, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - expose_ignore_description_1, - struct expose_ignore); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("expose-ignore", expose_ignore, + 0, expose_ignore_description_1, + struct expose_ignore); #else /* not NEW_GC */ extern const struct sized_memory_description expose_ignore_description; @@ -583,16 +580,15 @@ 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_NODUMP_LISP_OBJECT ("frame", frame, + mark_frame, print_frame, 0, 0, 0, + frame_description, + struct frame); static void nuke_all_frame_slots (struct frame *f) { - ZERO_LCRECORD (f); + ZERO_LISP_OBJECT (f); #define MARKED_SLOT(x) f->x = Qnil; #include "frameslots.h" @@ -606,12 +602,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; @@ -3867,9 +3862,9 @@ void syms_of_frame (void) { - INIT_LRECORD_IMPLEMENTATION (frame); + INIT_LISP_OBJECT (frame); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (expose_ignore); + INIT_LISP_OBJECT (expose_ignore); #endif /* NEW_GC */ DEFSYMBOL (Qdelete_frame_hook);
--- a/src/frame.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/frame.h Wed Feb 24 19:04:27 2010 -0600 @@ -60,7 +60,7 @@ extern Lisp_Object Vframe_icon_title_format, Vframe_title_format; extern Lisp_Object Vmouse_motion_handler; -DECLARE_LRECORD (frame, struct frame); +DECLARE_LISP_OBJECT (frame, struct frame); #define XFRAME(x) XRECORD (x, frame, struct frame) #define wrap_frame(p) wrap_record (p, frame) #define FRAMEP(x) RECORDP (x, frame)
--- a/src/glyphs.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/glyphs.c Wed Feb 24 19:04:27 2010 -0600 @@ -1112,7 +1112,7 @@ } static void -finalize_image_instance (void *header, int for_disksave) +finalize_image_instance (void *header) { Lisp_Image_Instance *i = (Lisp_Image_Instance *) header; @@ -1121,7 +1121,6 @@ || NILP (IMAGE_INSTANCE_DEVICE (i))) return; - if (for_disksave) finalose (i); /* We can't use the domain here, because it might have disappeared. */ @@ -1314,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_NODUMP_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 @@ -1351,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 @@ -1994,7 +1990,7 @@ device-specific method to copy the window-system subobject. */ new_ = allocate_image_instance (XIMAGE_INSTANCE_DOMAIN (image_instance), Qnil, Qnil); - COPY_LCRECORD (XIMAGE_INSTANCE (new_), XIMAGE_INSTANCE (image_instance)); + COPY_LISP_OBJECT (XIMAGE_INSTANCE (new_), XIMAGE_INSTANCE (image_instance)); /* note that if this method returns non-zero, this method MUST copy any window-system resources, so that when one image instance is freed, the other one is not hosed. */ @@ -3822,14 +3818,14 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph, - 1, /*dumpable-flag*/ - mark_glyph, print_glyph, 0, - glyph_equal, glyph_hash, - glyph_description, - glyph_getprop, glyph_putprop, - glyph_remprop, glyph_plist, - Lisp_Glyph); +DEFINE_DUMPABLE_GENERAL_LISP_OBJECT ("glyph", glyph, + mark_glyph, print_glyph, 0, + glyph_equal, glyph_hash, + glyph_description, + glyph_getprop, glyph_putprop, + glyph_remprop, glyph_plist, + 0 /* no disksaver */, + Lisp_Glyph); Lisp_Object allocate_glyph (enum glyph_type type, @@ -3837,8 +3833,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 */ @@ -3884,7 +3880,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; @@ -4554,7 +4549,7 @@ XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)) = delq_no_quit (value, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))); - finalize_image_instance (XIMAGE_INSTANCE (value), 0); + finalize_image_instance (XIMAGE_INSTANCE (value)); } } return 0; @@ -4657,7 +4652,7 @@ struct expose_ignore *ei; #ifdef NEW_GC - ei = alloc_lrecord_type (struct expose_ignore, &lrecord_expose_ignore); + ei = XEXPOSE_IGNORE (ALLOC_LISP_OBJECT (expose_ignore)); #else /* not NEW_GC */ ei = Blocktype_alloc (the_expose_ignore_blocktype); #endif /* not NEW_GC */ @@ -5194,8 +5189,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/glyphs.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/glyphs.h Wed Feb 24 19:04:27 2010 -0600 @@ -432,7 +432,7 @@ /* Image Instance Object */ /************************************************************************/ -DECLARE_LRECORD (image_instance, Lisp_Image_Instance); +DECLARE_LISP_OBJECT (image_instance, Lisp_Image_Instance); #define XIMAGE_INSTANCE(x) XRECORD (x, image_instance, Lisp_Image_Instance) #define wrap_image_instance(p) wrap_record (p, image_instance) #define IMAGE_INSTANCEP(x) RECORDP (x, image_instance) @@ -596,7 +596,7 @@ struct Lisp_Image_Instance { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object domain; /* The domain in which we were cached. */ Lisp_Object device; /* The device of the domain. Recorded since the domain may get deleted @@ -948,7 +948,7 @@ struct Lisp_Glyph { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; enum glyph_type type; @@ -968,7 +968,7 @@ }; typedef struct Lisp_Glyph Lisp_Glyph; -DECLARE_LRECORD (glyph, Lisp_Glyph); +DECLARE_LISP_OBJECT (glyph, Lisp_Glyph); #define XGLYPH(x) XRECORD (x, glyph, Lisp_Glyph) #define wrap_glyph(p) wrap_record (p, glyph) #define GLYPHP(x) RECORDP (x, glyph) @@ -1070,7 +1070,7 @@ struct glyph_cachel { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Lisp_Object glyph; @@ -1090,7 +1090,7 @@ #ifdef NEW_GC typedef struct glyph_cachel Lisp_Glyph_Cachel; -DECLARE_LRECORD (glyph_cachel, Lisp_Glyph_Cachel); +DECLARE_LISP_OBJECT (glyph_cachel, Lisp_Glyph_Cachel); #define XGLYPH_CACHEL(x) \ XRECORD (x, glyph_cachel, Lisp_Glyph_Cachel) @@ -1198,7 +1198,7 @@ struct expose_ignore { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ int x, y; int width, height; @@ -1206,7 +1206,7 @@ }; #ifdef NEW_GC -DECLARE_LRECORD (expose_ignore, struct expose_ignore); +DECLARE_LISP_OBJECT (expose_ignore, struct expose_ignore); #define XEXPOSE_IGNORE(x) XRECORD (x, expose_ignore, struct expose_ignore) #define wrap_expose_ignore(p) wrap_record (p, expose_ignore) #define EXPOSE_IGNOREP(x) RECORDP (x, expose_ignore)
--- a/src/gui.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/gui.c Wed Feb 24 19:04:27 2010 -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; } /* @@ -807,13 +803,12 @@ RETURN_UNGCPRO (ret); } -DEFINE_LRECORD_IMPLEMENTATION ("gui-item", gui_item, - 0, /*dumpable-flag*/ - mark_gui_item, print_gui_item, - 0, gui_item_equal, - gui_item_hash, - gui_item_description, - Lisp_Gui_Item); +DEFINE_NODUMP_LISP_OBJECT ("gui-item", gui_item, + mark_gui_item, print_gui_item, + 0, gui_item_equal, + gui_item_hash, + gui_item_description, + Lisp_Gui_Item); DOESNT_RETURN gui_error (const Ascbyte *reason, Lisp_Object frob) @@ -830,7 +825,7 @@ void syms_of_gui (void) { - INIT_LRECORD_IMPLEMENTATION (gui_item); + INIT_LISP_OBJECT (gui_item); DEFSYMBOL (Qmenu_no_selection_hook);
--- a/src/gui.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/gui.h Wed Feb 24 19:04:27 2010 -0600 @@ -44,7 +44,7 @@ menu item or submenu properties */ struct Lisp_Gui_Item { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object name; /* String */ Lisp_Object callback; /* Symbol or form */ Lisp_Object callback_ex; /* Form taking context arguments */ @@ -60,7 +60,7 @@ Lisp_Object value; /* Anything you like */ }; -DECLARE_LRECORD (gui_item, Lisp_Gui_Item); +DECLARE_LISP_OBJECT (gui_item, Lisp_Gui_Item); #define XGUI_ITEM(x) XRECORD (x, gui_item, Lisp_Gui_Item) #define wrap_gui_item(p) wrap_record (p, gui_item) #define GUI_ITEMP(x) RECORDP (x, gui_item)
--- a/src/inline.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/inline.c Wed Feb 24 19:04:27 2010 -0600 @@ -35,8 +35,8 @@ */ /* Note to maintainers: This file contains a list of all header files - that use the INLINE macro, either directly, or by using DECLARE_LRECORD. - i.e. the output of ``grep -l -w 'DECLARE_LRECORD|INLINE_HEADER' *.h'' */ + that use the INLINE macro, either directly, or by using DECLARE_LISP_OBJECT. + i.e. the output of ``grep -l -w 'DECLARE_LISP_OBJECT|INLINE_HEADER' *.h'' */ #define DONT_EXTERN_INLINE_HEADER_FUNCTIONS @@ -99,19 +99,26 @@ #include "database.h" #endif +#include "console-stream-impl.h" + #ifdef HAVE_X_WINDOWS -#include "glyphs-x.h" +#include "console-x-impl.h" #ifdef HAVE_XFT #include "font-mgr.h" #endif #endif #ifdef HAVE_MS_WINDOWS -#include "console-msw.h" +#include "console-msw-impl.h" +#endif + +#ifdef HAVE_TTY +#include "console-tty-impl.h" +#include "objects-tty-impl.h" #endif #ifdef HAVE_GTK -#include "console-gtk.h" +#include "console-gtk-impl.h" #include "ui-gtk.h" #endif
--- a/src/keymap.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/keymap.c Wed Feb 24 19:04:27 2010 -0600 @@ -148,7 +148,7 @@ struct Lisp_Keymap { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; #define MARKED_SLOT(x) Lisp_Object x; #include "keymap-slots.h" }; @@ -300,12 +300,11 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("keymap", keymap, - 1, /*dumpable-flag*/ - mark_keymap, print_keymap, 0, - keymap_equal, keymap_hash, - keymap_description, - Lisp_Keymap); +DEFINE_DUMPABLE_LISP_OBJECT ("keymap", keymap, + mark_keymap, print_keymap, 0, + keymap_equal, keymap_hash, + keymap_description, + Lisp_Keymap); /************************************************************************/ /* Traversing keymaps and their parents */ @@ -777,10 +776,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); #define MARKED_SLOT(x) keymap->x = Qnil; #include "keymap-slots.h" @@ -795,7 +792,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, /* @@ -4295,7 +4292,7 @@ void syms_of_keymap (void) { - INIT_LRECORD_IMPLEMENTATION (keymap); + INIT_LISP_OBJECT (keymap); DEFSYMBOL (Qminor_mode_map_alist);
--- a/src/keymap.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/keymap.h Wed Feb 24 19:04:27 2010 -0600 @@ -26,7 +26,7 @@ typedef struct Lisp_Keymap Lisp_Keymap; -DECLARE_LRECORD (keymap, Lisp_Keymap); +DECLARE_LISP_OBJECT (keymap, Lisp_Keymap); #define XKEYMAP(x) XRECORD (x, keymap, Lisp_Keymap) #define wrap_keymap(p) wrap_record (p, keymap) #define KEYMAPP(x) RECORDP (x, keymap)
--- a/src/lisp.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/lisp.h Wed Feb 24 19:04:27 2010 -0600 @@ -2383,7 +2383,7 @@ } face_cachel_dynarr; #ifdef NEW_GC -DECLARE_LRECORD (face_cachel_dynarr, face_cachel_dynarr); +DECLARE_LISP_OBJECT (face_cachel_dynarr, face_cachel_dynarr); #define XFACE_CACHEL_DYNARR(x) \ XRECORD (x, face_cachel_dynarr, face_cachel_dynarr) #define wrap_face_cachel_dynarr(p) wrap_record (p, face_cachel_dynarr) @@ -2398,7 +2398,7 @@ } glyph_cachel_dynarr; #ifdef NEW_GC -DECLARE_LRECORD (glyph_cachel_dynarr, glyph_cachel_dynarr); +DECLARE_LISP_OBJECT (glyph_cachel_dynarr, glyph_cachel_dynarr); #define XGLYPH_CACHEL_DYNARR(x) \ XRECORD (x, glyph_cachel_dynarr, glyph_cachel_dynarr) #define wrap_glyph_cachel_dynarr(p) wrap_record (p, glyph_cachel_dynarr) @@ -2459,7 +2459,7 @@ struct Lisp_Cons { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; Lisp_Object car_, cdr_; }; typedef struct Lisp_Cons Lisp_Cons; @@ -2476,7 +2476,7 @@ }; #endif -DECLARE_MODULE_API_LRECORD (cons, Lisp_Cons); +DECLARE_MODULE_API_LISP_OBJECT (cons, Lisp_Cons); #define XCONS(x) XRECORD (x, cons, Lisp_Cons) #define wrap_cons(p) wrap_record (p, cons) #define CONSP(x) RECORDP (x, cons) @@ -3014,13 +3014,13 @@ #ifdef NEW_GC struct Lisp_String_Direct_Data { - struct lrecord_header header; + LISP_OBJECT_HEADER header; Bytecount size; Ibyte data[1]; }; typedef struct Lisp_String_Direct_Data Lisp_String_Direct_Data; -DECLARE_MODULE_API_LRECORD (string_direct_data, Lisp_String_Direct_Data); +DECLARE_MODULE_API_LISP_OBJECT (string_direct_data, Lisp_String_Direct_Data); #define XSTRING_DIRECT_DATA(x) \ XRECORD (x, string_direct_data, Lisp_String_Direct_Data) #define wrap_string_direct_data(p) wrap_record (p, string_direct_data) @@ -3034,13 +3034,13 @@ struct Lisp_String_Indirect_Data { - struct lrecord_header header; + LISP_OBJECT_HEADER header; Bytecount size; Ibyte *data; }; typedef struct Lisp_String_Indirect_Data Lisp_String_Indirect_Data; -DECLARE_MODULE_API_LRECORD (string_indirect_data, Lisp_String_Indirect_Data); +DECLARE_MODULE_API_LISP_OBJECT (string_indirect_data, Lisp_String_Indirect_Data); #define XSTRING_INDIRECT_DATA(x) \ XRECORD (x, string_indirect_data, Lisp_String_Indirect_Data) #define wrap_string_indirect_data(p) wrap_record (p, string_indirect_data) @@ -3115,7 +3115,7 @@ #define MAX_STRING_ASCII_BEGIN ((1 << 21) - 1) #endif /* not NEW_GC */ -DECLARE_MODULE_API_LRECORD (string, Lisp_String); +DECLARE_MODULE_API_LISP_OBJECT (string, Lisp_String); #define XSTRING(x) XRECORD (x, string, Lisp_String) #define wrap_string(p) wrap_record (p, string) #define STRINGP(x) RECORDP (x, string) @@ -3188,13 +3188,13 @@ struct Lisp_Vector { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; long size; Lisp_Object contents[1]; }; typedef struct Lisp_Vector Lisp_Vector; -DECLARE_LRECORD (vector, Lisp_Vector); +DECLARE_LISP_OBJECT (vector, Lisp_Vector); #define XVECTOR(x) XRECORD (x, vector, Lisp_Vector) #define wrap_vector(p) wrap_record (p, vector) #define VECTORP(x) RECORDP (x, vector) @@ -3225,13 +3225,13 @@ struct Lisp_Bit_Vector { - struct LCRECORD_HEADER lheader; + LISP_OBJECT_HEADER lheader; Elemcount size; unsigned long bits[1]; }; typedef struct Lisp_Bit_Vector Lisp_Bit_Vector; -DECLARE_LRECORD (bit_vector, Lisp_Bit_Vector); +DECLARE_LISP_OBJECT (bit_vector, Lisp_Bit_Vector); #define XBIT_VECTOR(x) XRECORD (x, bit_vector, Lisp_Bit_Vector) #define wrap_bit_vector(p) wrap_record (p, bit_vector) #define BIT_VECTORP(x) RECORDP (x, bit_vector) @@ -3279,7 +3279,7 @@ /* For when we want to include a bit vector in another structure, and we know it's of a fixed size. */ #define DECLARE_INLINE_LISP_BIT_VECTOR(numbits) struct { \ - struct LCRECORD_HEADER lheader; \ + LISP_OBJECT_HEADER lheader; \ Elemcount size; \ unsigned long bits[BIT_VECTOR_LONG_STORAGE(numbits)]; \ } @@ -3314,7 +3314,7 @@ typedef struct Lisp_Symbol Lisp_Symbol; struct Lisp_Symbol { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; /* next symbol in this obarray bucket */ Lisp_Symbol *next; Lisp_Object name; @@ -3330,7 +3330,7 @@ XSTRING_LENGTH (symbol_name (XSYMBOL (sym)))))) #define KEYWORDP(obj) (SYMBOLP (obj) && SYMBOL_IS_KEYWORD (obj)) -DECLARE_MODULE_API_LRECORD (symbol, Lisp_Symbol); +DECLARE_MODULE_API_LISP_OBJECT (symbol, Lisp_Symbol); #define XSYMBOL(x) XRECORD (x, symbol, Lisp_Symbol) #define wrap_symbol(p) wrap_record (p, symbol) #define SYMBOLP(x) RECORDP (x, symbol) @@ -3358,7 +3358,7 @@ struct Lisp_Subr { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; short min_args; short max_args; /* #### We should make these const Ascbyte * or const Ibyte *, not const @@ -3370,7 +3370,7 @@ }; typedef struct Lisp_Subr Lisp_Subr; -DECLARE_LRECORD (subr, Lisp_Subr); +DECLARE_LISP_OBJECT (subr, Lisp_Subr); #define XSUBR(x) XRECORD (x, subr, Lisp_Subr) #define wrap_subr(p) wrap_record (p, subr) #define SUBRP(x) RECORDP (x, subr) @@ -3388,7 +3388,7 @@ typedef struct Lisp_Marker Lisp_Marker; struct Lisp_Marker { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; Lisp_Marker *next; Lisp_Marker *prev; struct buffer *buffer; @@ -3396,7 +3396,7 @@ char insertion_type; }; -DECLARE_MODULE_API_LRECORD (marker, Lisp_Marker); +DECLARE_MODULE_API_LISP_OBJECT (marker, Lisp_Marker); #define XMARKER(x) XRECORD (x, marker, Lisp_Marker) #define wrap_marker(p) wrap_record (p, marker) #define MARKERP(x) RECORDP (x, marker) @@ -3646,12 +3646,12 @@ struct Lisp_Float { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; union { double d; struct Lisp_Float *unused_next_; } data; }; typedef struct Lisp_Float Lisp_Float; -DECLARE_LRECORD (float, Lisp_Float); +DECLARE_LISP_OBJECT (float, Lisp_Float); #define XFLOAT(x) XRECORD (x, float, Lisp_Float) #define wrap_float(p) wrap_record (p, float) #define FLOATP(x) RECORDP (x, float) @@ -3734,7 +3734,7 @@ struct weak_box { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object value; Lisp_Object next_weak_box; /* don't mark through this! */ @@ -3744,7 +3744,7 @@ Lisp_Object make_weak_box (Lisp_Object value); Lisp_Object weak_box_ref (Lisp_Object value); -DECLARE_LRECORD (weak_box, struct weak_box); +DECLARE_LISP_OBJECT (weak_box, struct weak_box); #define XWEAK_BOX(x) XRECORD (x, weak_box, struct weak_box) #define XSET_WEAK_BOX(x, v) (XWEAK_BOX (x)->value = (v)) #define wrap_weak_box(p) wrap_record (p, weak_box) @@ -3756,7 +3756,7 @@ struct ephemeron { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object key; @@ -3781,7 +3781,7 @@ Lisp_Object zap_finalize_list(void); Lisp_Object make_ephemeron(Lisp_Object key, Lisp_Object value, Lisp_Object finalizer); -DECLARE_LRECORD(ephemeron, struct ephemeron); +DECLARE_LISP_OBJECT(ephemeron, struct ephemeron); #define XEPHEMERON(x) XRECORD (x, ephemeron, struct ephemeron) #define XEPHEMERON_REF(x) (XEPHEMERON (x)->value) #define XEPHEMERON_NEXT(x) (XCDR (XEPHEMERON(x)->cons_chain)) @@ -3815,13 +3815,13 @@ struct weak_list { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object list; /* don't mark through this! */ enum weak_list_type type; Lisp_Object next_weak; /* don't mark through this! */ }; -DECLARE_LRECORD (weak_list, struct weak_list); +DECLARE_LISP_OBJECT (weak_list, struct weak_list); #define XWEAK_LIST(x) XRECORD (x, weak_list, struct weak_list) #define wrap_weak_list(p) wrap_record (p, weak_list) #define WEAK_LISTP(x) RECORDP (x, weak_list) @@ -5778,7 +5778,10 @@ Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object); void float_to_string (char *, double); -void internal_object_printer (Lisp_Object, Lisp_Object, int); +void internal_object_printer (Lisp_Object obj, Lisp_Object printcharfun, + int UNUSED (escapeflag)); +void external_object_printer (Lisp_Object obj, Lisp_Object printcharfun, + int UNUSED (escapeflag)); MODULE_API DECLARE_DOESNT_RETURN (printing_unreadable_object (const CIbyte *, ...)) PRINTF_ARGS (1, 2);
--- a/src/lrecord.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/lrecord.h Wed Feb 24 19:04:27 2010 -0600 @@ -1,6 +1,6 @@ /* The "lrecord" structure (header of a compound lisp object). Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1996, 2001, 2002, 2004, 2005, 2010 Ben Wing. + Copyright (C) 1996, 2001, 2002, 2004, 2005, 2009, 2010 Ben Wing. This file is part of XEmacs. @@ -92,24 +92,28 @@ #ifdef NEW_GC -#define ALLOC_LCRECORD_TYPE alloc_lrecord_type -#define COPY_SIZED_LCRECORD copy_sized_lrecord -#define COPY_LCRECORD copy_lrecord -#define LISPOBJ_STORAGE_SIZE(ptr, size, stats) \ +#define ALLOC_LISP_OBJECT(type) alloc_lrecord (&lrecord_##type) +#define ALLOC_SIZED_LISP_OBJECT(size, type) \ + alloc_sized_lrecord (size, &lrecord_##type) +#define COPY_SIZED_LISP_OBJECT copy_sized_lrecord +#define COPY_LISP_OBJECT copy_lrecord +#define LISP_OBJECT_STORAGE_SIZE(ptr, size, stats) \ 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 +#define ZERO_LISP_OBJECT zero_lrecord +#define LISP_OBJECT_HEADER struct lrecord_header +#define FROB_BLOCK_LISP_OBJECT_HEADER struct lrecord_header +#define FREE_LISP_OBJECT free_lrecord #else /* not NEW_GC */ -#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 +#define ALLOC_LISP_OBJECT(type) alloc_automanaged_lcrecord (&lrecord_##type) +#define ALLOC_SIZED_LISP_OBJECT(size, type) \ + old_alloc_sized_lcrecord (size, &lrecord_##type) +#define COPY_SIZED_LISP_OBJECT old_copy_sized_lcrecord +#define COPY_LISP_OBJECT old_copy_lcrecord +#define LISP_OBJECT_STORAGE_SIZE malloced_storage_size +#define ZERO_LISP_OBJECT old_zero_lcrecord +#define LISP_OBJECT_HEADER struct old_lcrecord_header +#define FROB_BLOCK_LISP_OBJECT_HEADER struct lrecord_header +#define FREE_LISP_OBJECT old_free_lcrecord #endif /* not NEW_GC */ BEGIN_C_DECLS @@ -188,7 +192,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. @@ -376,21 +380,20 @@ mark methods will be removed. */ 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 - used instead. */ + /* `printer' converts the object to a printed representation. `printer' + should never be NULL (if so, you will get an assertion failure when + trying to print such an object). Either supply a specific printing + method, or use the default methods internal_object_printer() (for + internal objects that should not be visible at Lisp level) or + external_object_printer() (for objects visible at Lisp level). */ void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag); - /* `finalizer' is called at GC time when the object is about to be freed, - and at dump time (FOR_DISKSAVE will be non-zero in this case). It - should perform any necessary cleanup (e.g. freeing malloc()ed memory - or releasing objects created in external libraries, such as - window-system windows or file handles). This can be NULL, meaning no - special finalization is necessary. - - WARNING: remember that `finalizer' is called at dump time even though - the object is not being freed -- check the FOR_DISKSAVE argument. */ - void (*finalizer) (void *header, int for_disksave); + /* `finalizer' is called at GC time when the object is about to be freed. + It should perform any necessary cleanup, such as freeing malloc()ed + memory or releasing pointers or handles to objects created in external + libraries, such as window-system windows or file handles. This can be + NULL, meaning no special finalization is necessary. */ + void (*finalizer) (void *header); /* This can be NULL, meaning compare objects with EQ(). */ int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth, @@ -416,13 +419,25 @@ int (*remprop) (Lisp_Object obj, Lisp_Object prop); Lisp_Object (*plist) (Lisp_Object obj); -#ifdef NEW_GC - /* Only one of `static_size' and `size_in_bytes_method' is non-0. */ -#else /* not NEW_GC */ - /* 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 NEW_GC */ + /* `disksaver' is called at dump time. It is used for objects that + contain pointers or handles to objects created in external libraries, + such as window-system windows or file handles. Such external objects + cannot be dumped, so it is necessary to release them at dump time and + arrange somehow or other for them to be resurrected if necessary later + on. + + It seems that even non-dumpable objects may be around at dump time, + and a disksaver may be provided. (In fact, the only object currently + with a disksaver, lstream, is non-dumpable.) + + Objects rarely need to provide this method; most of the time it will + be NULL. */ + void (*disksaver) (Lisp_Object); + + /* 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); @@ -481,7 +496,7 @@ if (MCACF_implementation && MCACF_implementation->finalizer) \ { \ GC_STAT_FINALIZED; \ - MCACF_implementation->finalizer (ptr, 0); \ + MCACF_implementation->finalizer (ptr); \ } \ } \ } while (0) @@ -496,8 +511,8 @@ { \ const struct lrecord_implementation *MCACF_implementation \ = LHEADER_IMPLEMENTATION (MCACF_lheader); \ - if (MCACF_implementation && MCACF_implementation->finalizer) \ - MCACF_implementation->finalizer (ptr, 1); \ + if (MCACF_implementation && MCACF_implementation->disksaver) \ + MCACF_implementation->disksaver (MCACF_obj); \ } \ } while (0) @@ -754,7 +769,7 @@ struct Lisp_Hash_Table { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Elemcount size; Elemcount count; Elemcount rehash_count; @@ -819,7 +834,7 @@ struct Lisp_Specifier { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; struct specifier_methods *methods; ... @@ -1153,88 +1168,178 @@ #define XD_INDIRECT_VAL(code) ((-1 - (code)) & 255) #define XD_INDIRECT_DELTA(code) ((-1 - (code)) >> 8) -/* 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. (Either + DEFINE_DUMPABLE_LISP_OBJECT for objects that can be saved in a dumped + executable, or DEFINE_NODUMP_LISP_OBJECT for objects that cannot be + saved -- e.g. that contain pointers to non-persistent external objects + such as window-system windows.) + + 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 + NEW_GC, because it does this automatically. + + DEFINE_*_INTERNAL_LISP_OBJECT is for "internal" objects that should + never be visible on the Lisp level. This is a shorthand for the most + common type of internal objects, which have no equal or hash method + (since they generally won't appear in hash tables), no finalizer and + internal_object_printer() as their print method (which prints that the + object is internal and shouldn't be visible externally). For internal + objects needing a finalizer, equal or hash method, or wanting to + customize the print method, use the normal DEFINE_*_LISP_OBJECT + mechanism for defining these objects. + + DEFINE_*_GENERAL_LISP_OBJECT is for objects that need to provide one of + the less common methods that are omitted on most objects. These methods + include the methods supporting the unified property interface using + `get', `put', `remprop' and `object-plist', and (for dumpable objects + only) the `disksaver' method. + + DEFINE_MODULE_* is for objects defined in an external module. + + MAKE_LISP_OBJECT and MAKE_MODULE_LISP_OBJECT are what underlies all of + these; they define a structure containing pointers to object methods + and other info such as the size of the structure containing the object. */ +/* #### FIXME What's going on here? */ #if defined (ERROR_CHECK_TYPES) # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype) #else # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype) #endif +/********* The dumpable versions *********** */ -#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_DUMPABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ +DEFINE_DUMPABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype) + +#define DEFINE_DUMPABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \ +MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof (structtype),0,0,structtype) + +#define DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,structtype) + +#define DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizer,structtype) \ +MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,0,sizer,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) +#define DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ +DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype) + +#define DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \ +MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof(structtype),0,1,structtype) -#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_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +MAKE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,0,sizer,1,structtype) + +#define DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,structtype) \ +DEFINE_DUMPABLE_GENERAL_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,0,structtype) + +#define DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,sizer,structtype) \ +DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,0,sizer,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) +/********* The non-dumpable versions *********** */ + +#define DEFINE_NODUMP_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ +DEFINE_NODUMP_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype) -#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_NODUMP_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \ +MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof (structtype),0,0,structtype) + +#define DEFINE_NODUMP_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,structtype) + +#define DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizer,structtype) \ +MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,0,sizer,0,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_NODUMP_FROB_BLOCK_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ +DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype) + +#define DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \ +MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof(structtype),0,1,structtype) -#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_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +MAKE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,0,sizer,1,structtype) + +#define DEFINE_NODUMP_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,structtype) \ +DEFINE_NODUMP_GENERAL_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,0,structtype) + +#define DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT(name,c_name,marker,desc,sizer,structtype) \ +DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,marker,internal_object_printer,0,0,0,desc,0,0,0,0,0,sizer,structtype) + +/********* MAKE_LISP_OBJECT, the underlying macro *********** */ #ifdef NEW_GC -#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,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,size,sizer,frob_block_p,structtype) \ 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, \ + getprop, putprop, remprop, plist, disksaver, size, sizer, \ lrecord_type_##c_name } #else /* not NEW_GC */ -#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,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,size,sizer,frob_block_p,structtype) \ 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 } + getprop, putprop, remprop, plist, disksaver, size, sizer, \ + lrecord_type_##c_name, frob_block_p } #endif /* not NEW_GC */ -#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) + +/********* The module dumpable versions *********** */ + +#define DEFINE_DUMPABLE_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ +DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,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_DUMPABLE_MODULE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \ +MAKE_MODULE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof (structtype),0,0,structtype) + +#define DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,structtype) + +#define DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizer,structtype) \ +MAKE_MODULE_LISP_OBJECT(name,c_name,1 /*dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,0,sizer,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) +/********* The module non-dumpable versions *********** */ + +#define DEFINE_NODUMP_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ +DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,structtype) + +#define DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,structtype) \ +MAKE_MODULE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizeof (structtype),0,0,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_NODUMP_MODULE_SIZABLE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,structtype) + +#define DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,sizer,structtype) \ +MAKE_MODULE_LISP_OBJECT(name,c_name,0 /*non-dumpable*/,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,0,sizer,0,structtype) + +/********* MAKE_MODULE_LISP_OBJECT, the underlying macro *********** */ #ifdef NEW_GC -#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_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,size,sizer,frob_block_p,structtype) \ DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ int lrecord_type_##c_name; \ struct lrecord_implementation lrecord_##c_name = \ { name, dumpable, marker, printer, nuker, equal, hash, desc, \ - getprop, putprop, remprop, plist, size, sizer, \ + getprop, putprop, remprop, plist, disksaver, size, sizer, \ lrecord_type_last_built_in_type } #else /* not NEW_GC */ -#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_MODULE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,disksaver,size,sizer,frob_block_p,structtype) \ DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ int lrecord_type_##c_name; \ struct lrecord_implementation lrecord_##c_name = \ { name, dumpable, marker, printer, nuker, equal, hash, desc, \ - getprop, putprop, remprop, plist, size, sizer, \ - lrecord_type_last_built_in_type, basic_p } + getprop, putprop, remprop, plist, disksaver, size, sizer, \ + lrecord_type_last_built_in_type, frob_block_p } #endif /* not NEW_GC */ #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; \ @@ -1242,40 +1347,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_MODULE_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_MODULE_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 */ @@ -1291,9 +1396,9 @@ 1. Declare the struct for your object in a header file somewhere. Remember that it must begin with - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; - 2. Put the "standard junk" (DECLARE_RECORD()/XFOO/etc.) below the + 2. Put the "standard junk" (DECLARE_LISP_OBJECT()/XFOO/etc.) below the struct definition -- see below. 3. Add this header file to inline.c. @@ -1306,12 +1411,17 @@ 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 - variant. + 6. Define your object with DEFINE_*_LISP_OBJECT() or some + variant. At the minimum, you need to decide whether your object can + be dumped. Objects that are created as part of the loadup process and + need to be persistent across dumping should be created dumpable. + Nondumpable objects are generally those associated with display, + particularly those containing a pointer to an external library object + (e.g. a window-system window). 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 @@ -1325,7 +1435,7 @@ struct toolbar_button { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object next; Lisp_Object frame; @@ -1356,7 +1466,7 @@ [[ the standard junk: ]] -DECLARE_LRECORD (toolbar_button, struct toolbar_button); +DECLARE_LISP_OBJECT (toolbar_button, struct toolbar_button); #define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button) #define wrap_toolbar_button(p) wrap_record (p, toolbar_button) #define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button) @@ -1401,20 +1511,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_NODUMP_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); ...; } @@ -1442,9 +1550,9 @@ /* 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 +part of the XEmacs main source code) should use DECLARE_*_MODULE_LISP_OBJECT +and DEFINE_*_MODULE_LISP_OBJECT rather than DECLARE_*_LISP_OBJECT +and DEFINE_*_LISP_OBJECT. The MODULE versions declare and allocate an enumerator for the type being defined. */ @@ -1452,7 +1560,7 @@ #ifdef ERROR_CHECK_TYPES -# define DECLARE_LRECORD(c_name, structtype) \ +# define DECLARE_LISP_OBJECT(c_name, structtype) \ extern const struct lrecord_implementation lrecord_##c_name; \ DECLARE_INLINE_HEADER ( \ structtype * \ @@ -1464,7 +1572,7 @@ } \ extern Lisp_Object Q##c_name##p -# define DECLARE_MODULE_API_LRECORD(c_name, structtype) \ +# define DECLARE_MODULE_API_LISP_OBJECT(c_name, structtype) \ extern MODULE_API const struct lrecord_implementation lrecord_##c_name; \ DECLARE_INLINE_HEADER ( \ structtype * \ @@ -1476,7 +1584,7 @@ } \ extern MODULE_API Lisp_Object Q##c_name##p -# define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \ +# define DECLARE_MODULE_LISP_OBJECT(c_name, structtype) \ extern int lrecord_type_##c_name; \ extern struct lrecord_implementation lrecord_##c_name; \ DECLARE_INLINE_HEADER ( \ @@ -1489,21 +1597,8 @@ } \ extern Lisp_Object Q##c_name##p -# define DECLARE_NONRECORD(c_name, type_enum, structtype) \ -DECLARE_INLINE_HEADER ( \ -structtype * \ -error_check_##c_name (Lisp_Object obj, const Ascbyte *file, int line) \ -) \ -{ \ - assert_at_line (XTYPE (obj) == type_enum, file, line); \ - return (structtype *) XPNTR (obj); \ -} \ -extern Lisp_Object Q##c_name##p - # define XRECORD(x, c_name, structtype) \ error_check_##c_name (x, __FILE__, __LINE__) -# define XNONRECORD(x, c_name, type_enum, structtype) \ - error_check_##c_name (x, __FILE__, __LINE__) DECLARE_INLINE_HEADER ( Lisp_Object @@ -1522,21 +1617,17 @@ #else /* not ERROR_CHECK_TYPES */ -# define DECLARE_LRECORD(c_name, structtype) \ +# define DECLARE_LISP_OBJECT(c_name, structtype) \ extern Lisp_Object Q##c_name##p; \ extern const struct lrecord_implementation lrecord_##c_name -# define DECLARE_MODULE_API_LRECORD(c_name, structtype) \ -extern MODULE_API Lisp_Object Q##c_name##p; \ +# define DECLARE_MODULE_API_LISP_OBJECT(c_name, structtype) \ +extern MODULE_API Lisp_Object Q##c_name##p; \ extern MODULE_API const struct lrecord_implementation lrecord_##c_name -# define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \ +# define DECLARE_MODULE_LISP_OBJECT(c_name, structtype) \ extern Lisp_Object Q##c_name##p; \ extern int lrecord_type_##c_name; \ extern struct lrecord_implementation lrecord_##c_name -# define DECLARE_NONRECORD(c_name, type_enum, structtype) \ -extern Lisp_Object Q##c_name##p # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x)) -# define XNONRECORD(x, c_name, type_enum, structtype) \ - ((structtype *) XPNTR (x)) /* wrap_pointer_1 is so named as a suggestion not to use it unless you know what you're doing. */ #define wrap_record(ptr, ty) wrap_pointer_1 (ptr) @@ -1585,18 +1676,38 @@ 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_LISP_OBJECT. + + - 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_LISP_OBJECT() on such + on object! (At least when not NEW_GC) + + - Basic lrecords (of which there are a limited number, which exist only + when not NEW_GC, 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 NEW_GC /*-------------------------- lcrecord-list -----------------------------*/ struct lcrecord_list { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object free; Elemcount size; const struct lrecord_implementation *implementation; }; -DECLARE_LRECORD (lcrecord_list, struct lcrecord_list); +DECLARE_LISP_OBJECT (lcrecord_list, struct lcrecord_list); #define XLCRECORD_LIST(x) XRECORD (x, lcrecord_list, struct lcrecord_list) #define wrap_lcrecord_list(p) wrap_record (p, lcrecord_list) #define LCRECORD_LISTP(x) RECORDP (x, lcrecord_list) @@ -1611,7 +1722,7 @@ lrecords. lcrecords themselves are divided into three types: (1) auto-managed, (2) hand-managed, and (3) unmanaged. "Managed" refers to using a special object called an lcrecord-list to keep track of freed - lcrecords, which can freed with FREE_LCRECORD() or the like and later be + lcrecords, which can freed with FREE_LISP_OBJECT() or the like and later be recycled when a new lcrecord is required, rather than requiring new malloc(). Thus, allocation of lcrecords can be very cheap. (Technically, the lcrecord-list manager could divide up large @@ -1625,9 +1736,9 @@ 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 + "FREE_LISP_OBJECT()" and the appropriate lcrecord-list manager is automatically located and called. The limitation here of course is that all your objects are of the same size. (#### Eventually we should have a more sophisticated system that tracks the sizes seen and creates one @@ -1648,7 +1759,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 @@ -1661,10 +1772,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 @@ -1674,7 +1785,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 @@ -1682,8 +1793,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, @@ -1693,12 +1805,14 @@ void free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord); /* AUTO-MANAGED MODEL: */ -MODULE_API void * -alloc_automanaged_lcrecord (Bytecount size, - const struct lrecord_implementation *); +MODULE_API Lisp_Object +alloc_automanaged_sized_lcrecord (Bytecount size, + const struct lrecord_implementation *imp); +MODULE_API Lisp_Object +alloc_automanaged_lcrecord (const struct lrecord_implementation *imp); -#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); @@ -1722,34 +1836,18 @@ #else /* NEW_GC */ -/* 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. - - - 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. */ +MODULE_API Lisp_Object alloc_sized_lrecord (Bytecount size, + const struct lrecord_implementation *imp); +Lisp_Object noseeum_alloc_sized_lrecord (Bytecount size, + const struct lrecord_implementation *imp); +MODULE_API Lisp_Object alloc_lrecord (const struct lrecord_implementation *imp); +Lisp_Object noseeum_alloc_lrecord (const struct lrecord_implementation *imp); -void *alloc_lrecord (Bytecount size, - const struct lrecord_implementation *); - -void *alloc_lrecord_array (Bytecount size, int elemcount, - const struct lrecord_implementation *); - -#define alloc_lrecord_type(type, lrecord_implementation) \ - ((type *) alloc_lrecord (sizeof (type), lrecord_implementation)) - -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)) +MODULE_API Lisp_Object alloc_lrecord_array (int elemcount, + const struct lrecord_implementation *imp); +MODULE_API Lisp_Object alloc_sized_lrecord_array (Bytecount size, + int elemcount, + const struct lrecord_implementation *imp); void free_lrecord (Lisp_Object rec);
--- a/src/lstream.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/lstream.c Wed Feb 24 19:04:27 2010 -0600 @@ -1,7 +1,7 @@ /* Generic stream implementation. Copyright (C) 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996, 2001, 2002 Ben Wing. + Copyright (C) 1996, 2001, 2002, 2010 Ben Wing. This file is part of XEmacs. @@ -69,37 +69,31 @@ } static void -finalize_lstream (void *header, int for_disksave) +finalize_lstream (void *header) { /* WARNING WARNING WARNING. This function (and all finalize functions) - may get called more than once on the same object, and may get called - (at dump time) on objects that are not being released. */ + may get called more than once on the same object. */ Lstream *lstr = (Lstream *) header; + if (lstr->flags & LSTREAM_FL_IS_OPEN) + Lstream_close (lstr); + + if (lstr->imp->finalizer) + (lstr->imp->finalizer) (lstr); +} + +static void +disksave_lstream (Lisp_Object lstream) +{ + Lstream *lstr = XLSTREAM (lstream); + #if 0 /* this may cause weird Broken Pipes? */ - if (for_disksave) - { - Lstream_pseudo_close (lstr); - return; - } + Lstream_pseudo_close (lstr); + return; #endif - if (lstr->flags & LSTREAM_FL_IS_OPEN) - { - if (for_disksave) - { - if (lstr->flags & LSTREAM_FL_CLOSE_AT_DISKSAVE) - Lstream_close (lstr); - } - else - /* Just close. */ - Lstream_close (lstr); - } - - if (!for_disksave) - { - if (lstr->imp->finalizer) - (lstr->imp->finalizer) (lstr); - } + if ((lstr->flags & LSTREAM_FL_IS_OPEN) && + (lstr->flags & LSTREAM_FL_CLOSE_AT_DISKSAVE)) + Lstream_close (lstr); } inline static Bytecount @@ -150,12 +144,14 @@ 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_NODUMP_SIZABLE_GENERAL_LISP_OBJECT ("stream", lstream, + mark_lstream, print_lstream, + finalize_lstream, + 0, 0, /* no equal or hash */ + lstream_description, + 0, 0, 0, 0, /* no property meths */ + disksave_lstream, + sizeof_lstream, Lstream); /* Change the buffering of a stream. See lstream.h. By default the @@ -197,9 +193,8 @@ { Lstream *p; #ifdef NEW_GC - 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 NEW_GC */ int i; @@ -1881,5 +1876,5 @@ void vars_of_lstream (void) { - INIT_LRECORD_IMPLEMENTATION (lstream); + INIT_LISP_OBJECT (lstream); }
--- a/src/lstream.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/lstream.h Wed Feb 24 19:04:27 2010 -0600 @@ -30,7 +30,7 @@ /* definition of Lstream object */ /************************************************************************/ -DECLARE_LRECORD (lstream, struct lstream); +DECLARE_LISP_OBJECT (lstream, struct lstream); #define XLSTREAM(x) XRECORD (x, lstream, struct lstream) #define wrap_lstream(p) wrap_record (p, lstream) #define LSTREAMP(x) RECORDP (x, lstream) @@ -230,7 +230,7 @@ struct lstream { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; const Lstream_implementation *imp; /* methods for this stream */ Lstream_buffering buffering; /* type of buffering in use */ Bytecount buffering_size; /* number of bytes buffered */
--- a/src/marker.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/marker.c Wed Feb 24 19:04:27 2010 -0600 @@ -107,27 +107,22 @@ #ifdef NEW_GC static void -finalize_marker (void *header, int for_disksave) +finalize_marker (void *header) { - if (!for_disksave) - { - Lisp_Object tem = wrap_marker (header); - unchain_marker (tem); - } + Lisp_Object tem = wrap_marker (header); + unchain_marker (tem); } -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, - 1, /*dumpable-flag*/ - mark_marker, print_marker, - finalize_marker, - marker_equal, marker_hash, - marker_description, Lisp_Marker); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("marker", marker, + mark_marker, print_marker, + finalize_marker, + marker_equal, marker_hash, + marker_description, Lisp_Marker); #else /* not NEW_GC */ -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, - 1, /*dumpable-flag*/ - mark_marker, print_marker, 0, - marker_equal, marker_hash, - marker_description, Lisp_Marker); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("marker", marker, + mark_marker, print_marker, 0, + marker_equal, marker_hash, + marker_description, Lisp_Marker); #endif /* not NEW_GC */ /* Operations on markers. */ @@ -530,7 +525,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 Wed Feb 24 11:08:30 2010 +0100 +++ b/src/mule-charset.c Wed Feb 24 19:04:27 2010 -0600 @@ -178,10 +178,9 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("charset", charset, - 1, /* dumpable flag */ - mark_charset, print_charset, 0, - 0, 0, charset_description, Lisp_Charset); +DEFINE_DUMPABLE_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? */ static Lisp_Object @@ -196,8 +195,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) { @@ -1002,7 +1001,7 @@ { struct Lisp_Charset *c = XCHARSET (charset); xzero (*stats); - stats->other += LISPOBJ_STORAGE_SIZE (c, sizeof (*c), ovstats); + stats->other += LISP_OBJECT_STORAGE_SIZE (c, sizeof (*c), ovstats); stats->from_unicode += compute_from_unicode_table_size (charset, ovstats); stats->to_unicode += compute_to_unicode_table_size (charset, ovstats); } @@ -1055,7 +1054,7 @@ void syms_of_mule_charset (void) { - INIT_LRECORD_IMPLEMENTATION (charset); + INIT_LISP_OBJECT (charset); DEFSUBR (Fcharsetp); DEFSUBR (Ffind_charset);
--- a/src/number.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/number.c Wed Feb 24 19:04:27 2010 -0600 @@ -1,5 +1,6 @@ /* Numeric types for XEmacs. Copyright (C) 2004 Jerry James. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. @@ -60,13 +61,14 @@ #ifdef NEW_GC static void -bignum_finalize (void *header, int for_disksave) +bignum_finalize (void *header) { - if (!for_disksave) - { - struct Lisp_Bignum *num = (struct Lisp_Bignum *) header; - bignum_fini (num->data); - } + struct Lisp_Bignum *num = (struct Lisp_Bignum *) header; + /* #### WARNING: It would be better to put some sort of check to make + sure this doesn't happen more than once, just in case --- + e.g. checking if it's zero before finalizing and then setting it to + zero after finalizing. */ + bignum_fini (num->data); } #define BIGNUM_FINALIZE bignum_finalize #else @@ -122,10 +124,10 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bignum", bignum, 1, 0, bignum_print, - BIGNUM_FINALIZE, bignum_equal, - bignum_hash, bignum_description, - Lisp_Bignum); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("bignum", bignum, 0, bignum_print, + BIGNUM_FINALIZE, bignum_equal, + bignum_hash, bignum_description, + Lisp_Bignum); #endif /* HAVE_BIGNUM */ @@ -153,13 +155,14 @@ #ifdef NEW_GC static void -ratio_finalize (void *header, int for_disksave) +ratio_finalize (void *header) { - if (!for_disksave) - { - struct Lisp_Ratio *num = (struct Lisp_Ratio *) header; - ratio_fini (num->data); - } + struct Lisp_Ratio *num = (struct Lisp_Ratio *) header; + /* #### WARNING: It would be better to put some sort of check to make + sure this doesn't happen more than once, just in case --- + e.g. checking if it's zero before finalizing and then setting it to + zero after finalizing. */ + ratio_fini (num->data); } #define RATIO_FINALIZE ratio_finalize #else @@ -184,9 +187,9 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("ratio", ratio, 0, 0, ratio_print, - RATIO_FINALIZE, ratio_equal, ratio_hash, - ratio_description, Lisp_Ratio); +DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("ratio", ratio, 0, ratio_print, + RATIO_FINALIZE, ratio_equal, ratio_hash, + ratio_description, Lisp_Ratio); #endif /* HAVE_RATIO */ @@ -258,13 +261,14 @@ #ifdef NEW_GC static void -bigfloat_finalize (void *header, int for_disksave) +bigfloat_finalize (void *header) { - if (!for_disksave) - { - struct Lisp_Bigfloat *num = (struct Lisp_Bigfloat *) header; - bigfloat_fini (num->bf); - } + struct Lisp_Bigfloat *num = (struct Lisp_Bigfloat *) header; + /* #### WARNING: It would be better to put some sort of check to make + sure this doesn't happen more than once, just in case --- + e.g. checking if it's zero before finalizing and then setting it to + zero after finalizing. */ + bigfloat_fini (num->bf); } #define BIGFLOAT_FINALIZE bigfloat_finalize #else @@ -289,10 +293,10 @@ { XD_END } }; -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bigfloat", bigfloat, 1, 0, - bigfloat_print, BIGFLOAT_FINALIZE, - bigfloat_equal, bigfloat_hash, - bigfloat_description, Lisp_Bigfloat); +DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("bigfloat", bigfloat, 0, + bigfloat_print, BIGFLOAT_FINALIZE, + bigfloat_equal, bigfloat_hash, + bigfloat_description, Lisp_Bigfloat); #endif /* HAVE_BIGFLOAT */ @@ -762,13 +766,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/number.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/number.h Wed Feb 24 19:04:27 2010 -0600 @@ -71,12 +71,12 @@ struct Lisp_Bignum { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; bignum data; }; typedef struct Lisp_Bignum Lisp_Bignum; -DECLARE_LRECORD (bignum, Lisp_Bignum); +DECLARE_LISP_OBJECT (bignum, Lisp_Bignum); #define XBIGNUM(x) XRECORD (x, bignum, Lisp_Bignum) #define wrap_bignum(p) wrap_record (p, bignum) #define BIGNUMP(x) RECORDP (x, bignum) @@ -159,12 +159,12 @@ struct Lisp_Ratio { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; ratio data; }; typedef struct Lisp_Ratio Lisp_Ratio; -DECLARE_LRECORD (ratio, Lisp_Ratio); +DECLARE_LISP_OBJECT (ratio, Lisp_Ratio); #define XRATIO(x) XRECORD (x, ratio, Lisp_Ratio) #define wrap_ratio(p) wrap_record (p, ratio) #define RATIOP(x) RECORDP (x, ratio) @@ -233,12 +233,12 @@ #ifdef HAVE_BIGFLOAT struct Lisp_Bigfloat { - struct lrecord_header lheader; + FROB_BLOCK_LISP_OBJECT_HEADER lheader; bigfloat bf; }; typedef struct Lisp_Bigfloat Lisp_Bigfloat; -DECLARE_LRECORD (bigfloat, Lisp_Bigfloat); +DECLARE_LISP_OBJECT (bigfloat, Lisp_Bigfloat); #define XBIGFLOAT(x) XRECORD (x, bigfloat, Lisp_Bigfloat) #define wrap_bigfloat(p) wrap_record (p, bigfloat) #define BIGFLOATP(x) RECORDP (x, bigfloat)
--- a/src/objects-impl.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/objects-impl.h Wed Feb 24 19:04:27 2010 -0600 @@ -99,7 +99,7 @@ struct Lisp_Color_Instance { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object name; Lisp_Object device; @@ -119,7 +119,7 @@ struct Lisp_Font_Instance { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object name; /* the instantiator used to create the font instance */ Lisp_Object truename; /* used by the device-specific methods; we need to call them to get the truename (#### in reality,
--- a/src/objects-tty-impl.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/objects-tty-impl.h Wed Feb 24 19:04:27 2010 -0600 @@ -30,13 +30,13 @@ struct tty_color_instance_data { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Lisp_Object symbol; /* so we don't have to constantly call Fintern() */ }; #ifdef NEW_GC -DECLARE_LRECORD (tty_color_instance_data, struct tty_color_instance_data); +DECLARE_LISP_OBJECT (tty_color_instance_data, struct tty_color_instance_data); #define XTTY_COLOR_INSTANCE_DATA(x) \ XRECORD (x, tty_color_instance_data, struct tty_color_instance_data) #define wrap_tty_color_instance_data(p) \ @@ -56,13 +56,13 @@ struct tty_font_instance_data { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ Lisp_Object charset; }; #ifdef NEW_GC -DECLARE_LRECORD (tty_font_instance_data, struct tty_font_instance_data); +DECLARE_LISP_OBJECT (tty_font_instance_data, struct tty_font_instance_data); #define XTTY_FONT_INSTANCE_DATA(x) \ XRECORD (x, tty_font_instance_data, struct tty_font_instance_data) #define wrap_tty_font_instance_data(p) \
--- a/src/objects-tty.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/objects-tty.c Wed Feb 24 19:04:27 2010 -0600 @@ -43,12 +43,10 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("tty-color-instance-data", - tty_color_instance_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - tty_color_instance_data_description_1, - struct tty_color_instance_data); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("tty-color-instance-data", + tty_color_instance_data, + 0, tty_color_instance_data_description_1, + struct tty_color_instance_data); #else /* not NEW_GC */ const struct sized_memory_description tty_color_instance_data_description = { sizeof (struct tty_color_instance_data), tty_color_instance_data_description_1 @@ -61,12 +59,10 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("tty-font-instance-data", - tty_font_instance_data, - 0, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - tty_font_instance_data_description_1, - struct tty_font_instance_data); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("tty-font-instance-data", + tty_font_instance_data, 0, + tty_font_instance_data_description_1, + struct tty_font_instance_data); #else /* not NEW_GC */ const struct sized_memory_description tty_font_instance_data_description = { sizeof (struct tty_font_instance_data), tty_font_instance_data_description_1 @@ -195,8 +191,8 @@ /* Don't allocate the data until we're sure that we will succeed. */ #ifdef NEW_GC - c->data = alloc_lrecord_type (struct tty_color_instance_data, - &lrecord_tty_color_instance_data); + c->data = + XTTY_COLOR_INSTANCE_DATA (ALLOC_LISP_OBJECT (tty_color_instance_data)); #else /* not NEW_GC */ c->data = xnew (struct tty_color_instance_data); #endif /* not NEW_GC */ @@ -280,8 +276,8 @@ /* Don't allocate the data until we're sure that we will succeed. */ #ifdef NEW_GC - f->data = alloc_lrecord_type (struct tty_font_instance_data, - &lrecord_tty_font_instance_data); + f->data = + XTTY_FONT_INSTANCE_DATA (ALLOC_LISP_OBJECT (tty_font_instance_data)); #else /* not NEW_GC */ f->data = xnew (struct tty_font_instance_data); #endif /* not NEW_GC */ @@ -397,8 +393,8 @@ syms_of_objects_tty (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (tty_color_instance_data); - INIT_LRECORD_IMPLEMENTATION (tty_font_instance_data); + INIT_LISP_OBJECT (tty_color_instance_data); + INIT_LISP_OBJECT (tty_font_instance_data); #endif /* NEW_GC */ DEFSUBR (Fregister_tty_color);
--- a/src/objects.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/objects.c Wed Feb 24 19:04:27 2010 -0600 @@ -113,15 +113,12 @@ } static void -finalize_color_instance (void *header, int for_disksave) +finalize_color_instance (void *header) { Lisp_Color_Instance *c = (Lisp_Color_Instance *) header; if (!NILP (c->device)) - { - if (for_disksave) finalose (c); - MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c)); - } + MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c)); } static int @@ -150,13 +147,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_NODUMP_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). @@ -177,13 +173,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; @@ -195,7 +193,7 @@ if (!retval) return Qnil; - return wrap_color_instance (c); + return obj; } DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /* @@ -333,13 +331,12 @@ } static void -finalize_font_instance (void *header, int for_disksave) +finalize_font_instance (void *header) { Lisp_Font_Instance *f = (Lisp_Font_Instance *) header; if (!NILP (f->device)) { - if (for_disksave) finalose (f); MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f)); } } @@ -368,12 +365,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_NODUMP_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); /* #### Why is this exposed to Lisp? Used in: @@ -394,6 +390,7 @@ */ (name, device, noerror, charset)) { + Lisp_Object obj; Lisp_Font_Instance *f; int retval = 0; Error_Behavior errb = decode_error_behavior_flag (noerror); @@ -405,7 +402,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; @@ -426,7 +424,7 @@ if (!retval) return Qnil; - return wrap_font_instance (f); + return obj; } DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /* @@ -1219,8 +1217,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); @@ -1295,21 +1293,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; @@ -1320,7 +1317,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/objects.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/objects.h Wed Feb 24 19:04:27 2010 -0600 @@ -30,7 +30,7 @@ * Color Instance Object * ****************************************************************************/ -DECLARE_LRECORD (color_instance, Lisp_Color_Instance); +DECLARE_LISP_OBJECT (color_instance, Lisp_Color_Instance); #define XCOLOR_INSTANCE(x) XRECORD (x, color_instance, Lisp_Color_Instance) #define wrap_color_instance(p) wrap_record (p, color_instance) #define COLOR_INSTANCEP(x) RECORDP (x, color_instance) @@ -51,7 +51,7 @@ void initialize_charset_font_caches (struct device *d); void invalidate_charset_font_caches (Lisp_Object charset); -DECLARE_LRECORD (font_instance, Lisp_Font_Instance); +DECLARE_LISP_OBJECT (font_instance, Lisp_Font_Instance); #define XFONT_INSTANCE(x) XRECORD (x, font_instance, Lisp_Font_Instance) #define wrap_font_instance(p) wrap_record (p, font_instance) #define FONT_INSTANCEP(x) RECORDP (x, font_instance)
--- a/src/opaque.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/opaque.c Wed Feb 24 19:04:27 2010 -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! */ @@ -116,12 +115,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_DUMPABLE_SIZABLE_LISP_OBJECT ("opaque", opaque, + 0, print_opaque, 0, + equal_opaque, hash_opaque, + opaque_description, + sizeof_opaque, Lisp_Opaque); /* stuff to handle opaque pointers */ @@ -155,19 +153,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_NODUMP_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 NEW_GC - 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 NEW_GC */ Lisp_Object res = alloc_managed_lcrecord (Vopaque_ptr_free_list); #endif /* not NEW_GC */ @@ -201,8 +196,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 NEW_GC reinit_opaque_early ();
--- a/src/opaque.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/opaque.h Wed Feb 24 19:04:27 2010 -0600 @@ -28,12 +28,12 @@ typedef struct Lisp_Opaque { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Bytecount size; max_align_t data[1]; } Lisp_Opaque; -DECLARE_LRECORD (opaque, Lisp_Opaque); +DECLARE_LISP_OBJECT (opaque, Lisp_Opaque); #define XOPAQUE(x) XRECORD (x, opaque, Lisp_Opaque) #define wrap_opaque(p) wrap_record (p, opaque) #define OPAQUEP(x) RECORDP (x, opaque) @@ -54,11 +54,11 @@ typedef struct Lisp_Opaque_Ptr { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; void *ptr; } Lisp_Opaque_Ptr; -DECLARE_LRECORD (opaque_ptr, Lisp_Opaque_Ptr); +DECLARE_LISP_OBJECT (opaque_ptr, Lisp_Opaque_Ptr); #define XOPAQUE_PTR(x) XRECORD (x, opaque_ptr, Lisp_Opaque_Ptr) #define wrap_opaque_ptr(p) wrap_record (p, opaque_ptr) #define OPAQUE_PTRP(x) RECORDP (x, opaque_ptr)
--- a/src/print.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/print.c Wed Feb 24 19:04:27 2010 -0600 @@ -1539,7 +1539,7 @@ DOESNT_RETURN printing_unreadable_lcrecord (Lisp_Object obj, const Ibyte *name) { - struct LCRECORD_HEADER *header = (struct LCRECORD_HEADER *) XPNTR (obj); + LISP_OBJECT_HEADER *header = (LISP_OBJECT_HEADER *) XPNTR (obj); #ifndef NEW_GC /* This must be a real lcrecord */ @@ -1568,10 +1568,10 @@ } void -default_object_printer (Lisp_Object obj, Lisp_Object printcharfun, - int UNUSED (escapeflag)) +external_object_printer (Lisp_Object obj, Lisp_Object printcharfun, + int UNUSED (escapeflag)) { - struct LCRECORD_HEADER *header = (struct LCRECORD_HEADER *) XPNTR (obj); + LISP_OBJECT_HEADER *header = (LISP_OBJECT_HEADER *) XPNTR (obj); #ifndef NEW_GC /* This must be a real lcrecord */ @@ -1594,6 +1594,12 @@ 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)); + /* Internal objects shouldn't normally escape to the Lisp level; that's why we say "XEmacs bug?". This can happen, however, when printing backtraces. */ @@ -1935,11 +1941,13 @@ } } - if (LHEADER_IMPLEMENTATION (lheader)->printer) - ((LHEADER_IMPLEMENTATION (lheader)->printer) - (obj, printcharfun, escapeflag)); - else - internal_object_printer (obj, printcharfun, escapeflag); + /* Either use a custom-written printer, or use + internal_object_printer or external_object_printer, depending on + whether the object is internal (not visible at Lisp level) or + external. */ + assert (LHEADER_IMPLEMENTATION (lheader)->printer); + ((LHEADER_IMPLEMENTATION (lheader)->printer) + (obj, printcharfun, escapeflag)); break; }
--- a/src/process-nt.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/process-nt.c Wed Feb 24 19:04:27 2010 -0600 @@ -656,9 +656,8 @@ } static void -nt_finalize_process_data (Lisp_Process *p, int for_disksave) +nt_finalize_process_data (Lisp_Process *p) { - assert (!for_disksave); /* If it's still in the list of processes we are waiting on delete it. This can happen if we forcibly delete a process and are unable to kill it. */ @@ -1159,7 +1158,7 @@ of handles when lots of processes are run. (The handle gets closed anyway upon GC, but that might be a ways away, esp. if deleted-exited-processes is set to nil.) */ - nt_finalize_process_data (p, 0); + nt_finalize_process_data (p); } /*
--- a/src/process.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/process.c Wed Feb 24 19:04:27 2010 -0600 @@ -2,7 +2,7 @@ Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996, 2001, 2002, 2004, 2005 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002, 2004, 2005, 2010 Ben Wing. This file is part of XEmacs. @@ -176,30 +176,25 @@ #endif /* HAVE_WINDOW_SYSTEM */ static void -finalize_process (void *header, int for_disksave) +finalize_process (void *header) { /* #### this probably needs to be tied into the tty event loop */ /* #### when there is one */ Lisp_Process *p = (Lisp_Process *) header; #ifdef HAVE_WINDOW_SYSTEM - if (!for_disksave) - { - debug_process_finalization (p); - } + debug_process_finalization (p); #endif /* HAVE_WINDOW_SYSTEM */ if (p->process_data) { - MAYBE_PROCMETH (finalize_process_data, (p, for_disksave)); - if (!for_disksave) - xfree (p->process_data); + MAYBE_PROCMETH (finalize_process_data, (p)); + xfree (p->process_data); } } -DEFINE_LRECORD_IMPLEMENTATION ("process", process, - 0, /*dumpable-flag*/ - mark_process, print_process, finalize_process, - 0, 0, process_description, Lisp_Process); +DEFINE_NODUMP_LISP_OBJECT ("process", process, + mark_process, print_process, finalize_process, + 0, 0, process_description, Lisp_Process); /************************************************************************/ /* basic process accessors */ @@ -468,9 +463,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" @@ -495,10 +491,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 @@ -2491,7 +2485,7 @@ void syms_of_process (void) { - INIT_LRECORD_IMPLEMENTATION (process); + INIT_LISP_OBJECT (process); DEFSYMBOL (Qprocessp); DEFSYMBOL (Qprocess_live_p);
--- a/src/process.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/process.h Wed Feb 24 19:04:27 2010 -0600 @@ -27,7 +27,7 @@ /* struct Lisp_Process is defined in procimpl.h; only process-*.c need to know about the guts of it. */ -DECLARE_LRECORD (process, Lisp_Process); +DECLARE_LISP_OBJECT (process, Lisp_Process); #define XPROCESS(x) XRECORD (x, process, Lisp_Process) #define wrap_process(p) wrap_record (p, process) #define PROCESSP(x) RECORDP (x, process)
--- a/src/procimpl.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/procimpl.h Wed Feb 24 19:04:27 2010 -0600 @@ -39,7 +39,7 @@ struct process_methods { void (*print_process_data) (Lisp_Process *proc, Lisp_Object printcharfun); - void (*finalize_process_data) (Lisp_Process *proc, int for_disksave); + void (*finalize_process_data) (Lisp_Process *proc); void (*alloc_process_data) (Lisp_Process *p); void (*init_process_io_handles) (Lisp_Process *p, void* in, void* out, void *err, int flags); @@ -94,7 +94,7 @@ struct Lisp_Process { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; /* Exit code if process has terminated, signal which stopped/interrupted process
--- a/src/rangetab.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/rangetab.c Wed Feb 24 19:04:27 2010 -0600 @@ -220,12 +220,11 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("range-table", range_table, - 1, /*dumpable-flag*/ - mark_range_table, print_range_table, 0, - range_table_equal, range_table_hash, - range_table_description, - Lisp_Range_Table); +DEFINE_DUMPABLE_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); /************************************************************************/ /* Range table operations */ @@ -332,11 +331,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, /* @@ -347,17 +346,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_begin (rt->entries), Dynarr_length (rt->entries)); - return wrap_range_table (rtnew); + return obj; } DEFUN ("get-range-table", Fget_range_table, 2, 3, 0, /* @@ -902,7 +903,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/rangetab.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/rangetab.h Wed Feb 24 19:04:27 2010 -0600 @@ -49,13 +49,13 @@ struct Lisp_Range_Table { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; range_table_entry_dynarr *entries; enum range_table_type type; }; typedef struct Lisp_Range_Table Lisp_Range_Table; -DECLARE_LRECORD (range_table, Lisp_Range_Table); +DECLARE_LISP_OBJECT (range_table, Lisp_Range_Table); #define XRANGE_TABLE(x) XRECORD (x, range_table, Lisp_Range_Table) #define wrap_range_table(p) wrap_record (p, range_table) #define RANGE_TABLEP(x) RECORDP (x, range_table)
--- a/src/scrollbar.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/scrollbar.c Wed Feb 24 19:04:27 2010 -0600 @@ -96,12 +96,10 @@ 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_NODUMP_INTERNAL_LISP_OBJECT ("scrollbar-instance", scrollbar_instance, + mark_scrollbar_instance, + scrollbar_instance_description, + struct scrollbar_instance); static void free_scrollbar_instance (struct scrollbar_instance *instance, @@ -198,9 +196,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)); @@ -272,7 +269,7 @@ while (inst) { - total += LISPOBJ_STORAGE_SIZE (inst, sizeof (*inst), ovstats); + total += LISP_OBJECT_STORAGE_SIZE (inst, sizeof (*inst), ovstats); inst = inst->next; } @@ -928,7 +925,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/scrollbar.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/scrollbar.h Wed Feb 24 19:04:27 2010 -0600 @@ -27,7 +27,7 @@ struct scrollbar_instance { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; /* Used by the frame caches. */ struct scrollbar_instance *next; @@ -47,7 +47,7 @@ void *scrollbar_data; }; -DECLARE_LRECORD (scrollbar_instance, struct scrollbar_instance); +DECLARE_LISP_OBJECT (scrollbar_instance, struct scrollbar_instance); #define XSCROLLBAR_INSTANCE(x) XRECORD (x, scrollbar_instance, struct scrollbar_instance) #define wrap_scrollbar_instance(p) wrap_record (p, scrollbar_instance) #define SCROLLBAR_INSTANCEP(x) RECORDP (x, scrollbar_instance)
--- a/src/specifier.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/specifier.c Wed Feb 24 19:04:27 2010 -0600 @@ -307,11 +307,10 @@ #ifndef NEW_GC static void -finalize_specifier (void *header, int for_disksave) +finalize_specifier (void *header) { Lisp_Specifier *sp = (Lisp_Specifier *) header; - /* don't be snafued by the disksave finalization. */ - if (!for_disksave && !GHOST_SPECIFIER_P(sp) && sp->caching) + if (!GHOST_SPECIFIER_P(sp) && sp->caching) { xfree (sp->caching); sp->caching = 0; @@ -395,12 +394,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("specifier-caching", - specifier_caching, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - specifier_caching_description_1, - struct specifier_caching); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("specifier-caching", specifier_caching, + 0, specifier_caching_description_1, + struct specifier_caching); #else /* not NEW_GC */ static const struct sized_memory_description specifier_caching_description = { sizeof (struct specifier_caching), @@ -447,22 +443,20 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("specifier", specifier, - 1, /*dumpable-flag*/ - mark_specifier, print_specifier, - 0, specifier_equal, specifier_hash, - specifier_description, - sizeof_specifier, - Lisp_Specifier); +DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("specifier", specifier, + mark_specifier, print_specifier, + 0, specifier_equal, specifier_hash, + specifier_description, + sizeof_specifier, + Lisp_Specifier); #else /* not NEW_GC */ -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_DUMPABLE_SIZABLE_LISP_OBJECT ("specifier", specifier, + mark_specifier, print_specifier, + finalize_specifier, + specifier_equal, specifier_hash, + specifier_description, + sizeof_specifier, + Lisp_Specifier); #endif /* not NEW_GC */ /************************************************************************/ @@ -526,10 +520,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; @@ -542,7 +535,6 @@ sp->caching = 0; sp->next_specifier = Vall_specifiers; - specifier = wrap_specifier (sp); Vall_specifiers = specifier; if (call_create_meth) @@ -3394,8 +3386,7 @@ if (!sp->caching) #ifdef NEW_GC - sp->caching = alloc_lrecord_type (struct specifier_caching, - &lrecord_specifier_caching); + sp->caching = XSPECIFIER_CACHING (ALLOC_LISP_OBJECT (specifier_caching)); #else /* not NEW_GC */ sp->caching = xnew_and_zero (struct specifier_caching); #endif /* not NEW_GC */ @@ -3750,9 +3741,9 @@ void syms_of_specifier (void) { - INIT_LRECORD_IMPLEMENTATION (specifier); + INIT_LISP_OBJECT (specifier); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (specifier_caching); + INIT_LISP_OBJECT (specifier_caching); #endif /* NEW_GC */ DEFSYMBOL (Qspecifierp);
--- a/src/specifier.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/specifier.h Wed Feb 24 19:04:27 2010 -0600 @@ -220,7 +220,7 @@ struct Lisp_Specifier { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; struct specifier_methods *methods; /* we keep a chained list of all current specifiers, for GC cleanup @@ -259,7 +259,7 @@ }; typedef struct Lisp_Specifier Lisp_Specifier; -DECLARE_LRECORD (specifier, Lisp_Specifier); +DECLARE_LISP_OBJECT (specifier, Lisp_Specifier); #define XSPECIFIER(x) XRECORD (x, specifier, Lisp_Specifier) #define wrap_specifier(p) wrap_record (p, specifier) #define SPECIFIERP(x) RECORDP (x, specifier) @@ -428,7 +428,7 @@ struct specifier_caching { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ int offset_into_struct_window; void (*value_changed_in_window) (Lisp_Object specifier, struct window *w, @@ -440,7 +440,7 @@ }; #ifdef NEW_GC -DECLARE_LRECORD (specifier_caching, struct specifier_caching); +DECLARE_LISP_OBJECT (specifier_caching, struct specifier_caching); #define XSPECIFIER_CACHING(x) \ XRECORD (x, specifier_caching, struct specifier_caching) #define wrap_specifier_caching(p) \
--- a/src/symbols.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/symbols.c Wed Feb 24 19:04:27 2010 -0600 @@ -141,14 +141,14 @@ return external_remprop (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME); } -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("symbol", symbol, - 1, /*dumpable-flag*/ +DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT ("symbol", symbol, mark_symbol, print_symbol, 0, 0, 0, symbol_description, symbol_getprop, symbol_putprop, symbol_remprop, Fsymbol_plist, + 0 /* no disksaver */, Lisp_Symbol); /**********************************************************************/ @@ -1115,37 +1115,33 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("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", - 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", - 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", - symbol_value_varalias, - 1, /*dumpable-flag*/ - mark_symbol_value_varalias, - print_symbol_value_magic, 0, 0, 0, - symbol_value_varalias_description, - struct symbol_value_varalias); +DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-forward", + symbol_value_forward, + 0, + print_symbol_value_magic, 0, 0, 0, + symbol_value_forward_description, + struct symbol_value_forward); + +DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-buffer-local", + symbol_value_buffer_local, + mark_symbol_value_buffer_local, + print_symbol_value_magic, 0, 0, 0, + symbol_value_buffer_local_description, + struct symbol_value_buffer_local); + +DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-lisp-magic", + symbol_value_lisp_magic, + mark_symbol_value_lisp_magic, + print_symbol_value_magic, 0, 0, 0, + symbol_value_lisp_magic_description, + struct symbol_value_lisp_magic); + +DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-varalias", + symbol_value_varalias, + mark_symbol_value_varalias, + print_symbol_value_magic, 0, 0, 0, + symbol_value_varalias_description, + struct symbol_value_varalias); /* Getting and setting values of symbols */ @@ -2293,8 +2289,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; @@ -2401,8 +2397,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; @@ -3193,8 +3189,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++) { @@ -3411,8 +3408,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 = aliased; bfwd->shadowed = valcontents; @@ -3535,11 +3532,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/symeval.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/symeval.h Wed Feb 24 19:04:27 2010 -0600 @@ -77,7 +77,7 @@ struct symbol_value_magic { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; void *value; enum symbol_value_type type; }; @@ -141,7 +141,7 @@ int (*magicfun) (Lisp_Object sym, Lisp_Object *val, Lisp_Object in_object, int flags); }; -DECLARE_LRECORD (symbol_value_forward, struct symbol_value_forward); +DECLARE_LISP_OBJECT (symbol_value_forward, struct symbol_value_forward); #define XSYMBOL_VALUE_FORWARD(x) \ XRECORD (x, symbol_value_forward, struct symbol_value_forward) #define symbol_value_forward_forward(m) ((void *)((m)->magic.value)) @@ -228,7 +228,7 @@ Lisp_Object current_buffer; Lisp_Object current_alist_element; }; -DECLARE_LRECORD (symbol_value_buffer_local, struct symbol_value_buffer_local); +DECLARE_LISP_OBJECT (symbol_value_buffer_local, struct symbol_value_buffer_local); #define XSYMBOL_VALUE_BUFFER_LOCAL(x) \ XRECORD (x, symbol_value_buffer_local, struct symbol_value_buffer_local) #define SYMBOL_VALUE_BUFFER_LOCAL_P(x) RECORDP (x, symbol_value_buffer_local) @@ -253,7 +253,7 @@ Lisp_Object harg[MAGIC_HANDLER_MAX]; Lisp_Object shadowed; }; -DECLARE_LRECORD (symbol_value_lisp_magic, struct symbol_value_lisp_magic); +DECLARE_LISP_OBJECT (symbol_value_lisp_magic, struct symbol_value_lisp_magic); #define XSYMBOL_VALUE_LISP_MAGIC(x) \ XRECORD (x, symbol_value_lisp_magic, struct symbol_value_lisp_magic) #define SYMBOL_VALUE_LISP_MAGIC_P(x) RECORDP (x, symbol_value_lisp_magic) @@ -266,7 +266,7 @@ Lisp_Object aliasee; Lisp_Object shadowed; }; -DECLARE_LRECORD (symbol_value_varalias, struct symbol_value_varalias); +DECLARE_LISP_OBJECT (symbol_value_varalias, struct symbol_value_varalias); #define XSYMBOL_VALUE_VARALIAS(x) \ XRECORD (x, symbol_value_varalias, struct symbol_value_varalias) #define SYMBOL_VALUE_VARALIAS_P(x) RECORDP (x, symbol_value_varalias) @@ -401,8 +401,7 @@ do \ { \ struct symbol_value_forward *I_hate_C = \ - alloc_lrecord_type (struct symbol_value_forward, \ - &lrecord_symbol_value_forward); \ + XSYMBOL_VALUE_FORWARD (ALLOC_LISP_OBJECT (symbol_value_forward)); \ /* mcpro ((Lisp_Object) I_hate_C);*/ \ \ MARK_LRECORD_AS_LISP_READONLY (I_hate_C); \ @@ -489,7 +488,7 @@ void flush_all_buffer_local_cache (void); struct multiple_value { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Elemcount count; Elemcount allocated_count; Elemcount first_desired; @@ -497,7 +496,7 @@ }; typedef struct multiple_value multiple_value; -DECLARE_LRECORD (multiple_value, multiple_value); +DECLARE_LISP_OBJECT (multiple_value, multiple_value); #define MULTIPLE_VALUEP(x) RECORDP (x, multiple_value) #define XMULTIPLE_VALUE(x) XRECORD (x, multiple_value, multiple_value)
--- a/src/syntax.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/syntax.c Wed Feb 24 19:04:27 2010 -0600 @@ -259,11 +259,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("syntax-cache", syntax_cache, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - syntax_cache_description_1, - Lisp_Syntax_Cache); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("syntax-cache", syntax_cache, + 0, syntax_cache_description_1, + Lisp_Syntax_Cache); #else /* not NEW_GC */ const struct sized_memory_description syntax_cache_description = { @@ -523,8 +521,7 @@ { struct syntax_cache *cache; #ifdef NEW_GC - buf->syntax_cache = alloc_lrecord_type (struct syntax_cache, - &lrecord_syntax_cache); + buf->syntax_cache = XSYNTAX_CACHE (ALLOC_LISP_OBJECT (syntax_cache)); #else /* not NEW_GC */ buf->syntax_cache = xnew_and_zero (struct syntax_cache); #endif /* not NEW_GC */ @@ -2393,7 +2390,7 @@ syms_of_syntax (void) { #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (syntax_cache); + INIT_LISP_OBJECT (syntax_cache); #endif /* NEW_GC */ DEFSYMBOL (Qsyntax_table_p); DEFSYMBOL (Qsyntax_table);
--- a/src/syntax.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/syntax.h Wed Feb 24 19:04:27 2010 -0600 @@ -296,7 +296,7 @@ struct syntax_cache { #ifdef NEW_GC - struct lrecord_header header; + LISP_OBJECT_HEADER header; #endif /* NEW_GC */ int use_code; /* Whether to use syntax_code or syntax_table. This is set @@ -339,7 +339,7 @@ #ifdef NEW_GC typedef struct syntax_cache Lisp_Syntax_Cache; -DECLARE_LRECORD (syntax_cache, Lisp_Syntax_Cache); +DECLARE_LISP_OBJECT (syntax_cache, Lisp_Syntax_Cache); #define XSYNTAX_CACHE(x) \ XRECORD (x, syntax_cache, Lisp_Syntax_Cache)
--- a/src/toolbar.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/toolbar.c Wed Feb 24 19:04:27 2010 -0600 @@ -88,13 +88,10 @@ return data->help_string; } -DEFINE_LRECORD_IMPLEMENTATION ("toolbar-button", toolbar_button, - 0, /*dumpable-flag*/ - mark_toolbar_button, - default_object_printer, - 0, 0, 0, - toolbar_button_description, - struct toolbar_button); +DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("toolbar-button", toolbar_button, + mark_toolbar_button, + 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. @@ -305,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; @@ -1332,7 +1329,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/toolbar.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/toolbar.h Wed Feb 24 19:04:27 2010 -0600 @@ -38,7 +38,7 @@ struct toolbar_button { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object next; Lisp_Object frame; @@ -69,7 +69,7 @@ int border_width; }; -DECLARE_LRECORD (toolbar_button, struct toolbar_button); +DECLARE_LISP_OBJECT (toolbar_button, struct toolbar_button); #define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button) #define wrap_toolbar_button(p) wrap_record (p, toolbar_button) #define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button)
--- a/src/tooltalk.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/tooltalk.c Wed Feb 24 19:04:27 2010 -0600 @@ -147,7 +147,7 @@ struct Lisp_Tooltalk_Message { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object plist_sym, callback; Tt_message m; }; @@ -178,24 +178,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_NODUMP_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 @@ -224,7 +222,7 @@ struct Lisp_Tooltalk_Pattern { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; Lisp_Object plist_sym, callback; Tt_pattern p; }; @@ -255,25 +253,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_NODUMP_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 @@ -1314,8 +1310,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/tooltalk.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/tooltalk.h Wed Feb 24 19:04:27 2010 -0600 @@ -27,14 +27,14 @@ #include TT_C_H_FILE typedef struct Lisp_Tooltalk_Message Lisp_Tooltalk_Message; -DECLARE_LRECORD (tooltalk_message, Lisp_Tooltalk_Message); +DECLARE_LISP_OBJECT (tooltalk_message, Lisp_Tooltalk_Message); #define XTOOLTALK_MESSAGE(x) XRECORD (x, tooltalk_message, Lisp_Tooltalk_Message) #define wrap_tooltalk_message(p) wrap_record (p, tooltalk_message) #define TOOLTALK_MESSAGEP(x) RECORDP (x, tooltalk_message) #define CHECK_TOOLTALK_MESSAGE(x) CHECK_RECORD (x, tooltalk_message) typedef struct Lisp_Tooltalk_Pattern Lisp_Tooltalk_Pattern; -DECLARE_LRECORD (tooltalk_pattern, Lisp_Tooltalk_Pattern); +DECLARE_LISP_OBJECT (tooltalk_pattern, Lisp_Tooltalk_Pattern); #define XTOOLTALK_PATTERN(x) XRECORD (x, tooltalk_pattern, Lisp_Tooltalk_Pattern) #define wrap_tooltalk_pattern(p) wrap_record (p, tooltalk_pattern) #define TOOLTALK_PATTERNP(x) RECORDP (x, tooltalk_pattern)
--- a/src/ui-gtk.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/ui-gtk.c Wed Feb 24 19:04:27 2010 -0600 @@ -295,7 +295,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; @@ -333,11 +334,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_NODUMP_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 ... @@ -923,44 +923,33 @@ } static void -emacs_gtk_object_finalizer (void *header, int for_disksave) +emacs_gtk_object_finalizer (void *header) { emacs_gtk_object_data *data = (emacs_gtk_object_data *) header; - if (for_disksave) - { - Lisp_Object obj = wrap_emacs_gtk_object (data); - - - invalid_operation - ("Can't dump an emacs containing GtkObject objects", obj); - } - if (data->alive_p) - { - gtk_object_unref (data->object); - } + gtk_object_unref (data->object); } -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_NODUMP_GENERAL_LISP_OBJECT ("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 */ + 0, /* disksaver */ + 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; @@ -1138,19 +1127,14 @@ 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_NODUMP_LISP_OBJECT ("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, + emacs_gtk_boxed_data); /* Currently defined GTK_TYPE_BOXED structures are: GtkAccelGroup - @@ -1168,8 +1152,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; @@ -1355,9 +1339,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/ui-gtk.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/ui-gtk.h Wed Feb 24 19:04:27 2010 -0600 @@ -36,7 +36,7 @@ #define MAX_GTK_ARGS 100 typedef struct { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; GtkType return_type; GtkType args[MAX_GTK_ARGS]; gint n_args; @@ -45,7 +45,7 @@ ffi_marshalling_function marshal; } emacs_ffi_data; -DECLARE_LRECORD (emacs_ffi, emacs_ffi_data); +DECLARE_LISP_OBJECT (emacs_ffi, emacs_ffi_data); #define XFFI(x) XRECORD (x, emacs_ffi, emacs_ffi_data) #define wrap_emacs_ffi(p) wrap_record (p, emacs_ffi) @@ -54,13 +54,13 @@ /* Encapsulate a GtkObject in Lisp */ typedef struct { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; gboolean alive_p; GtkObject *object; Lisp_Object plist; } emacs_gtk_object_data; -DECLARE_LRECORD (emacs_gtk_object, emacs_gtk_object_data); +DECLARE_LISP_OBJECT (emacs_gtk_object, emacs_gtk_object_data); #define XGTK_OBJECT(x) XRECORD (x, emacs_gtk_object, emacs_gtk_object_data) #define wrap_emacs_gtk_object(p) wrap_record (p, emacs_gtk_object) @@ -71,12 +71,12 @@ /* Encapsulate a GTK_TYPE_BOXED in lisp */ typedef struct { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; GtkType object_type; void *object; } emacs_gtk_boxed_data; -DECLARE_LRECORD (emacs_gtk_boxed, emacs_gtk_boxed_data); +DECLARE_LISP_OBJECT (emacs_gtk_boxed, emacs_gtk_boxed_data); #define XGTK_BOXED(x) XRECORD (x, emacs_gtk_boxed, emacs_gtk_boxed_data) #define wrap_emacs_gtk_boxed(p) wrap_record (p, emacs_gtk_boxed)
--- a/src/window-impl.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/window-impl.h Wed Feb 24 19:04:27 2010 -0600 @@ -84,7 +84,7 @@ struct window { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; /* The upper left corner coordinates of this window, as integers (pixels) relative to upper left corner of frame = 0, 0 */ @@ -168,7 +168,7 @@ struct window_mirror { - struct LCRECORD_HEADER header; + LISP_OBJECT_HEADER header; /* Frame this mirror is on. */ struct frame *frame;
--- a/src/window.c Wed Feb 24 11:08:30 2010 +0100 +++ b/src/window.c Wed Feb 24 19:04:27 2010 -0600 @@ -182,11 +182,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("face-cachel", face_cachel, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - face_cachel_description_1, - Lisp_Face_Cachel); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("face-cachel", face_cachel, + 0, face_cachel_description_1, + Lisp_Face_Cachel); #endif /* NEW_GC */ static const struct sized_memory_description face_cachel_description = { @@ -204,11 +202,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("face-cachel-dynarr", face_cachel_dynarr, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - face_cachel_dynarr_description_1, - face_cachel_dynarr); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("face-cachel-dynarr", face_cachel_dynarr, + 0, face_cachel_dynarr_description_1, + face_cachel_dynarr); #else /* not NEW_GC */ static const struct sized_memory_description face_cachel_dynarr_description = { sizeof (face_cachel_dynarr), @@ -222,11 +218,9 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("glyph-cachel", glyph_cachel, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - glyph_cachel_description_1, - Lisp_Glyph_Cachel); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("glyph-cachel", glyph_cachel, + 0, glyph_cachel_description_1, + Lisp_Glyph_Cachel); #endif /* NEW_GC */ static const struct sized_memory_description glyph_cachel_description = { @@ -244,11 +238,10 @@ }; #ifdef NEW_GC -DEFINE_LRECORD_IMPLEMENTATION ("glyph-cachel-dynarr", glyph_cachel_dynarr, - 1, /*dumpable-flag*/ - 0, 0, 0, 0, 0, - glyph_cachel_dynarr_description_1, - glyph_cachel_dynarr); +DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("glyph-cachel-dynarr", + glyph_cachel_dynarr, 0, + glyph_cachel_dynarr_description_1, + glyph_cachel_dynarr); #else /* not NEW_GC */ static const struct sized_memory_description glyph_cachel_dynarr_description = { sizeof (glyph_cachel_dynarr), @@ -332,7 +325,7 @@ } static void -finalize_window (void *header, int UNUSED (for_disksave)) +finalize_window (void *header) { struct window *w = (struct window *) header; @@ -375,10 +368,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_NODUMP_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; \ @@ -397,8 +389,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" @@ -432,7 +424,7 @@ p->windows_changed = 1; p->shadow_thickness_changed = 1; - return val; + return obj; } #undef INIT_DISP_VARIABLE @@ -531,19 +523,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_NODUMP_INTERNAL_LISP_OBJECT ("window-mirror", window_mirror, + mark_window_mirror, + 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); @@ -2146,7 +2137,7 @@ /* Free the extra data structures attached to windows immediately so they don't sit around consuming excess space. They will be reinitialized by the window-configuration code as necessary. */ - finalize_window ((void *) w, 0); + finalize_window ((void *) w); /* Nobody should be accessing anything in this object any more, and making them Qnil allows for better GC'ing in case a pointer @@ -3874,12 +3865,11 @@ 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); - COPY_LCRECORD (p, o); + Lisp_Object obj = ALLOC_LISP_OBJECT (window); + struct window *p = XWINDOW (obj); + + COPY_LISP_OBJECT (p, o); /* Don't copy the pointers to the line start cache or the face instances. */ @@ -3899,13 +3889,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; @@ -5187,7 +5177,7 @@ { if (!mir) return; - stats->other += LISPOBJ_STORAGE_SIZE (mir, sizeof (*mir), ovstats); + stats->other += LISP_OBJECT_STORAGE_SIZE (mir, sizeof (*mir), ovstats); #ifdef HAVE_SCROLLBARS { struct device *d = XDEVICE (FRAME_DEVICE (mir->frame)); @@ -5211,7 +5201,7 @@ struct overhead_stats *ovstats) { xzero (*stats); - stats->other += LISPOBJ_STORAGE_SIZE (w, sizeof (*w), ovstats); + stats->other += LISP_OBJECT_STORAGE_SIZE (w, sizeof (*w), ovstats); stats->face += compute_face_cachel_usage (w->face_cachels, ovstats); stats->glyph += compute_glyph_cachel_usage (w->glyph_cachels, ovstats); stats->line_start += @@ -5444,13 +5434,13 @@ void syms_of_window (void) { - INIT_LRECORD_IMPLEMENTATION (window); - INIT_LRECORD_IMPLEMENTATION (window_mirror); + INIT_LISP_OBJECT (window); + INIT_LISP_OBJECT (window_mirror); #ifdef NEW_GC - INIT_LRECORD_IMPLEMENTATION (face_cachel); - INIT_LRECORD_IMPLEMENTATION (face_cachel_dynarr); - INIT_LRECORD_IMPLEMENTATION (glyph_cachel); - INIT_LRECORD_IMPLEMENTATION (glyph_cachel_dynarr); + INIT_LISP_OBJECT (face_cachel); + INIT_LISP_OBJECT (face_cachel_dynarr); + INIT_LISP_OBJECT (glyph_cachel); + INIT_LISP_OBJECT (glyph_cachel_dynarr); #endif /* NEW_GC */ DEFSYMBOL (Qwindowp);
--- a/src/window.h Wed Feb 24 11:08:30 2010 +0100 +++ b/src/window.h Wed Feb 24 19:04:27 2010 -0600 @@ -34,7 +34,7 @@ struct window; -DECLARE_LRECORD (window, struct window); +DECLARE_LISP_OBJECT (window, struct window); #define XWINDOW(x) XRECORD (x, window, struct window) #define wrap_window(p) wrap_record (p, window) #define WINDOWP(x) RECORDP (x, window) @@ -81,14 +81,14 @@ struct window_mirror; -DECLARE_LRECORD (window_mirror, struct window_mirror); +DECLARE_LISP_OBJECT (window_mirror, struct window_mirror); #define XWINDOW_MIRROR(x) XRECORD (x, window_mirror, struct window_mirror) #define wrap_window_mirror(p) wrap_record (p, window_mirror) #define WINDOW_MIRRORP(x) RECORDP (x, window_mirror) #define CHECK_WINDOW_MIRROR(x) CHECK_RECORD (x, window_mirror) #define CONCHECK_WINDOW_MIRROR(x) CONCHECK_RECORD (x, window_mirror) -DECLARE_LRECORD (window_configuration, struct window_config); +DECLARE_LISP_OBJECT (window_configuration, struct window_config); EXFUN (Fget_buffer_window, 3); EXFUN (Fmove_to_window_line, 2);
--- a/src/xemacs.def.in.in Wed Feb 24 11:08:30 2010 +0100 +++ b/src/xemacs.def.in.in Wed Feb 24 19:04:27 2010 -0600 @@ -36,7 +36,8 @@ /* Exported functions */ acons #ifdef NEW_GC -alloc_lrecord /* alloc_lrecord_type */ +alloc_lrecord /* ALLOC_LISP_OBJECT */ +alloc_sized_lrecord /* ALLOC_SIZED_LISP_OBJECT */ lrecord_subr /* DEFSUBR */ lrecord_symbol_value_forward /* DEFVAR_SYMVAL_FWD */ #ifdef DEBUG_XEMACS @@ -44,7 +45,8 @@ #endif mc_alloc /* DEFSUBR */ #else /* not NEW_GC */ -alloc_automanaged_lcrecord /* old_alloc_lcrecord_type */ +alloc_automanaged_lcrecord /* ALLOC_LISP_OBJECT */ +old_alloc_sized_lcrecord /* ALLOC_SIZED_LISP_OBJECT */ #endif /* not NEW_GC */ apply1 #ifdef USE_ASSERTIONS @@ -128,6 +130,7 @@ error_check_string_direct_data error_check_string_indirect_data #endif +error_check_symbol_value_forward #endif /* XEMACS_DEFS_NEEDS_ERROR_CHECK_TYPES_DECLS */ free_opaque_ptr get_coding_system_for_text_file