April 2005 - XEmacs-Patches - XEmacs Mailing List Archives

[core 21.5] SXEmacs interpretation of a JWZ idea -- %backup%~ 19 years, 8 months

Steve Youngs

A while back on -beta, JWZ mentioned that %backup%~ should probably go to `auto-save-directory'. This is how we did it at SXEmacs... This being another SXEmacs-originated change I'd feel more comfortable if another Reviewer gave this the go ahead before its committed. 2005-03-23 Steve Youngs <steve(a)sxemacs.org> * files.el (backup-buffer): Write "$backup$~" in `auto-save-directory' and fall back to $HOME if for some reason that isn't possible. Suggested By: Jamie Zawinski <jwz(a)jwz.org> Index: files.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/files.el,v retrieving revision 1.72 diff -u -p -r1.72 files.el --- files.el 17 Mar 2005 09:26:09 -0000 1.72 +++ files.el 23 Mar 2005 04:35:43 -0000 ＠＠ -2390,10 +2390,15 ＠＠ no longer accessible under its old name. (rename-file real-file-name backupname t) (setq setmodes (file-modes backupname))) (file-error - ;; If trouble writing the backup, write it in ~. + ;; If trouble writing the backup, write + ;; it in `auto-save-directory'. Fall + ;; back to $HOME if that's not possible. (setq backupname - (expand-file-name - (convert-standard-filename "~/%backup%~"))) + (expand-file-name "$backup%~" + (or (when (and auto-save-directory + (file-writable-p auto-save-directory)) + auto-save-directory) + (getenv "HOME")))) (lwarn 'file 'alert "Cannot write backup file; backing up in %s" (file-name-nondirectory backupname)) (sleep-for 1) -- |---<Steve Youngs>---------------<GnuPG KeyID: A94B3003>---| | I am Dyslexic of Borg. | | Fusistance is retile. Your arse will be laminated. | |------------------------------------<steve(a)sxemacs.org>---|

2 participants
3 comments

hexl.el -- just type hex 19 years, 8 months

Robert Widhopf-Fenk

Dear Xemacs-Patches, dear Keith, attached you will find three patches against the version of hexl.el of the Xemacs package "text-modes" version 1.84, so it does not apply cleanly to the GNU Emacs version ... =as-you-type.patch Adds as-you-type hex-input, i.e. when in the ASCII columns you will enter in ASCII and when in the HEX columns you will enter hex. You may easily switch between the two columns by TAB. =follow-hex.patch Modifies the extent highlighting the corresponding ASCII position to also highlight the corresponding HEX position. And it also adds the current hex-address to the modeline. =Changlog.patch for the ChangeLog of the xemacs package. Cheers Robert

1 participants
0 comments

[COMMIT] Minor copy-editing of the latin-euro-standards docs. 19 years, 8 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed. mule-packages/latin-euro-standards/ChangeLog addition: 2005-04-03 Aidan Kehoe <kehoea(a)parhasard.net> * latin-euro-standards.texi: Minor copy-editing; make the dir entry shorter, to give a better chance of it being seen. XEmacs Packages source patch: Diff command: cvs -q diff -u Files affected: mule-packages/latin-euro-standards/latin-euro-standards.texi Index: mule-packages/latin-euro-standards/latin-euro-standards.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/mule-packages/latin-euro-standards/latin-euro-standards.texi,v retrieving revision 1.1 diff -u -u -r1.1 latin-euro-standards.texi --- mule-packages/latin-euro-standards/latin-euro-standards.texi 2005/02/14 23:37:55 1.1 +++ mule-packages/latin-euro-standards/latin-euro-standards.texi 2005/04/03 10:55:19 ＠＠ -5,7 +5,7 ＠＠＠c ** #### something uses these headers, find out how and explain here ＠c %**start of header ＠setfilename latin-euro-standards.info -＠settitle Recent ISO 8859 character encoding standards +＠settitle Recent ISO 8859 character encoding standards. ＠setchapternewpage odd ＠c %**end of header ＠＠ -18,8 +18,7 ＠＠＠footnotestyle end ＠direntry -* latin-euro-standards:: Make recent ISO 8859 character -encodings available to XEmacs. +* latin-euro-standards:: Recent ISO 8859 encodings in XEmacs. ＠end direntry ＠c ** It is often convenient to use a macro for names which have unusual ＠＠ -216,7 +215,7 ＠＠ It is intended to be used by the Mule-UCS (＠pxref{Top,,, mule-ucs, Mule-UCS User Manual}) and Latin Unity (＠pxref{Top,,, latin-unity, Latin Unity for Emacsen}) packages, and was, indeed, refactored out -from the former. +from the latter. Each file provides a language environment named, e.g. ＠samp{Latin-7}, a coding system named ＠samp{iso-8859-13} (etc.) and a Mule character set -- “I, for instance, am gung-ho about open source because my family is being held hostage in Rob Malda’s basement. But who fact-checks me, or Enderle, when we say something in public? No-one!” -- Danny O’Brien

1 participants
0 comments

[AC] [PACKAGES (gnus)] Fix summary buffer menubar 19 years, 8 months

Steve Youngs

APPROVE COMMIT This fixes the dreaded "Unrecognised menu descriptor" error. Norbert, can you please roll a new Gnus package as soon as you're back on deck. Thanks, man. NOTE: This patch has been committed. gnus patch: ChangeLog files diff command: cvs -q diff -U 0 Files affected: ChangeLog Source files diff command: cvs -q diff -uN Files affected: lisp/gnus-sum.el Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/ChangeLog,v retrieving revision 1.90 diff -u -p -U0 -r1.90 ChangeLog --- ChangeLog 20 Mar 2005 11:32:00 -0000 1.90 +++ ChangeLog 3 Apr 2005 01:44:39 -0000 ＠＠ -0,0 +1,6 ＠＠ +2005-04-03 Steve Youngs <steve(a)sxemacs.org> + + * lisp/gnus-sum.el (gnus-summary-make-menu-bar): Fix an + "unrecognised menu descriptor" error. + From Katsumi Yamaoka <yamaoka(a)jpl.org> + Index: lisp/gnus-sum.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-sum.el,v retrieving revision 1.6 diff -u -p -u -r1.6 gnus-sum.el --- lisp/gnus-sum.el 13 Mar 2005 00:23:28 -0000 1.6 +++ lisp/gnus-sum.el 3 Apr 2005 01:44:22 -0000 ＠＠ -2250,7 +2250,7 ＠＠ gnus-summary-show-article-from-menu-as-c ,＠(if (featurep 'xemacs) '(t) '(:help "Generate and print a PostScript image"))]) ("Copy, move,... (Backend)" - ,＠(if (featurep 'xemacs) '(t) + ,＠(if (featurep 'xemacs) nil '(:help "Copying, moving, expiring articles...")) ["Respool article..." gnus-summary-respool-article t] ["Move article..." gnus-summary-move-article -- |---<Steve Youngs>---------------<GnuPG KeyID: A94B3003>---| | I am Dyslexic of Borg. | | Fusistance is retile. Your arse will be laminated. | |------------------------------------<steve(a)sxemacs.org>---|

1 participants
0 comments

[PATCH] [21.4] Preserve default-directory in subprocess when non-ASCII is involved 19 years, 8 months

Aidan Kehoe

RECOMMEND 21.4 Ar an dara lá de mí Aibréan, scríobh Glynn Clements: > On 21.4.15, Mule, with -vanilla: > > If (default-directory) contains any non-ASCII characters, M-! runs the > command with the cwd set to XEmacs' initial cwd. > > Playing around with various coding-system variables doesn't seem to > affect anything. > > Any ideas? Looks like the chdir before the exec wasn’t wrapped properly. 21.5 doesn’t have the problem, though. src/ChangeLog addition: 2005-04-02 Aidan Kehoe <kehoea(a)parhasard.net> * callproc.c (child_setup): Call sys_chdir instead of chdir, for the sake of Mule safety. XEmacs Stable source patch: Diff command: cvs -q diff -u Files affected: src/callproc.c Index: src/callproc.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Attic/callproc.c,v retrieving revision 1.37.2.2 diff -u -u -r1.37.2.2 callproc.c --- src/callproc.c 2002/10/31 15:07:30 1.37.2.2 +++ src/callproc.c 2005/04/02 19:27:29 ＠＠ -676,7 +676,7 ＠＠ should only return an error if the directory's permissions are changed between the check and this chdir, but we should at least check. */ - if (chdir (pwd + 4) < 0) + if (sys_chdir (pwd + 4) < 0) { /* Don't report the chdir error, or ange-ftp.el doesn't work. */ /* (FSFmacs does _exit (errno) here.) */ -- “I, for instance, am gung-ho about open source because my family is being held hostage in Rob Malda’s basement. But who fact-checks me, or Enderle, when we say something in public? No-one!” -- Danny O’Brien

1 participants
0 comments

[COMMIT] Write FCCs to Unix mailboxes using the binary coding system. 19 years, 8 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed. Previous to this change, if your default buffer-file-coding-system was UTF-8, your MIME content-transfer-encoding 8bit, and the mails you FCCed had non-ASCII content, the act of FCCing would read in the buffer as binary and write it out to the same file as UTF-8, changing every non-ASCII octet to its UTF-8 equivalent. On every FCC to the folder. Which is not healthy for your data. Patch posted to xemacs-beta back in December, with message ID 16848.46742.104431.578670.dm0(a)vm.parhasard.net . xemacs-packages/mail-lib/ChangeLog addition: 2005-04-02 Aidan Kehoe <kehoea(a)parhasard.net> * sendmail.el (mail-do-fcc): Write the Unix mail file using the binary coding system, as is appropriate for a file where non-ASCII characters are encoded using separate MIME character sets for every message, and thus no other single Mule coding system is appropriate. XEmacs Packages source patch: Diff command: cvs -q diff -u Files affected: xemacs-packages/mail-lib/sendmail.el Index: xemacs-packages/mail-lib/sendmail.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/mail-lib/sendmail.el,v retrieving revision 1.18 diff -u -u -r1.18 sendmail.el --- xemacs-packages/mail-lib/sendmail.el 2004/11/08 02:50:32 1.18 +++ xemacs-packages/mail-lib/sendmail.el 2005/04/01 22:21:15 ＠＠ -1225,8 +1225,16 ＠＠ (insert "\n\C-_") (write-region (point-min) (point-max) (car fcc-list) t) (erase-buffer))) - (write-region - (1+ (point-min)) (point-max) (car fcc-list) t))) + ;; MIME processing should have eliminated any characters + ;; outside the range 0-255; if MIME processing hasn't been + ;; done, there's no reasonable expectation that the data will + ;; be preserved in a Unix mailbox, so we just write tildes for + ;; those chars. We set the coding system for write to 'binary + ;; to prevent any double-encoding that may occur if + ;; buffer-file-coding-system has been initialised to a + ;; non-binary-compatible coding system like, say, UTF-8. + (let ((coding-system-for-write 'binary)) + (write-region (1+ (point-min)) (point-max) (car fcc-list) t)))) (and buffer (not dont-write-the-file) (with-current-buffer buffer (set-visited-file-modtime)))) -- “I, for instance, am gung-ho about open source because my family is being held hostage in Rob Malda’s basement. But who fact-checks me, or Enderle, when we say something in public? No-one!” -- Danny O’Brien

1 participants
0 comments

[PATCH] New Allocator 19 years, 8 months

Marcus Crestani

Here is the first big patch introducing the new allocator, called `mc-alloc'. It is another big step towards a new memory manager. All changes to the code are conditionend on `MC_ALLOC'. To enable the new allocator, configure with `--enable-mc-alloc'. The new allocator allocates objects size-based (in contrast to type-based, what the old allocator is using). This allows many simplifications: the distinction between lrecords and lcrecords is no longer needed, the two types are merged into one. Thus the interface to the allocator is reduced. This triggered changes to the garbage collector (without improving the algorithms), to the portable dumper and to many other parts of XEmacs. A detailed description of what I did and why I did it can be found here: http://www.crestani.de/mc-alloc/pdf/mc-alloc.pdf . The document will eventually become a part of the Internals Manual. I tested the changes thoroughly on the systems I have access to, which is especially Linux and FreeBSD. I also did some minimal testing on Windows and Solaris. I would tremendously appreciate if people give the new allocator a try and report back (especially if things go smoothly). Please keep in mind that the new allocator is work in progress! Currently, you cannot expect any performance benefit from this patch (but no degradation either). I'll continue working on the allocator and start on a new garbage collector. Both together eventually result in a fast and modern memory manager. Although the changes are conditioned on `MC_ALLOC', I'll wait a week to give people the time to look over the patch and read the documentation before I am committing. ChangeLog addition: 2005-04-01 Marcus Crestani <crestani(a)xemacs.org> The new allocator. New configure flag: `MC_ALLOC': * configure.ac (XE_COMPLEX_ARG_ENABLE): Add `--enable-mc-alloc' as a new configure flag. * configure.in (AC_INIT_PARSE_ARGS): Add `--mc-alloc' as a new configure flag. * configure.usage: Add description for `mc-alloc'. DUMP_IN_EXEC: * Makefile.in.in: Condition the installation of a separate dump file on !DUMP_ON_EXEC. * configure.ac (XE_COMPLEX_ARG_ENABLE): Add `--enable-dump-in-exec' as a new configure flag. * configure.ac: DUMP_IN_EXEC is define as default for PDUMP but not default for MC_ALLOC. * configure.in (AC_INIT_PARSE_ARGS): Add `--dump-in-exec' as a new configure flag. * configure.in: DUMP_IN_EXEC is define as default for PDUMP but not default for MC_ALLOC. * configure.usage: Add description for `dump-in-exec'. lib-src/ChangeLog addition: 2005-04-01 Marcus Crestani <crestani(a)xemacs.org> The new allocator. DUMP_IN_EXEC: * Makefile.in.in: Only compile insert-data-in-exec if DUMP_IN_EXEC is defined. lisp/ChangeLog addition: 2005-04-01 Marcus Crestani <crestani(a)xemacs.org> The new allocator. MEMORY_USAGE_STATS * diagnose.el: Add new lisp function to pretty print statistics about the new allocator. * diagnose.el (show-mc-alloc-memory-usage): New. modules/ChangeLog addition: 2005-04-01 Marcus Crestani <crestani(a)xemacs.org> The new allocator. Remove Lcrecords: * postgresql/postgresql.c (allocate_pgconn): Allocate with new allocator. * postgresql/postgresql.c (allocate_pgresult): Allocate PGresult with new allocator. * postgresql/postgresql.h (struct Lisp_PGconn): Add lrecord_header. * postgresql/postgresql.h (struct Lisp_PGresult): Add lrecord_header. * ldap/eldap.c (allocate_ldap): Allocate with new allocator. * ldap/eldap.h (struct Lisp_LDAP): Add lrecord_header. nt/ChangeLog addition: 2005-04-01 Marcus Crestani <crestani(a)xemacs.org> The new allocator. New configure flag: `MC_ALLOC': * config.inc.samp: Add new flag `MC_ALLOC'. * xemacs.mak: Add flag and configuration output for `MC_ALLOC'. New files: * xemacs.dsp: Add source files mc-alloc.c and mc-alloc.h. * xemacs.mak: Add new object file mc-alloc.obj to dependencies. src/ChangeLog addition: 2005-04-01 Marcus Crestani <crestani(a)xemacs.org> The new allocator. New configure flag: `MC_ALLOC': * config.h.in: Add new flag `MC_ALLOC'. New files: * Makefile.in.in: Add new object file mc-alloc.o. * depend: Add new files to dependencies. * mc-alloc.c: New. * mc-alloc.h: New. Running the new allocator from XEmacs: * alloc.c (deadbeef_memory): Moved to mc-alloc.c. * emacs.c (main_1): Initialize the new allocator and add syms_of_mc_alloc. * symsinit.h: Add syms_of_mc_alloc. New lrecord allocation and free functions: * alloc.c (alloc_lrecord): New. Allocates an lrecord, includes type checking and initializing of the lrecord_header. * alloc.c (noseeum_alloc_lrecord): Same as above, but increments the NOSEEUM cons counter. * alloc.c (free_lrecord): New. Calls the finalizer and frees the lrecord. * lrecord.h: Add lrecord allocation prototypes and comments. Remove old lrecord FROB block allocation: * alloc.c (allocate_lisp_storage): Former function to expand heap. Not needed anymore, remove. * alloc.c: Completely remove `Fixed-size type macros' * alloc.c (release_breathing_space): Remove. * alloc.c (memory_full): Remove release_breathing_space. * alloc.c (refill_memory_reserve): Remove. * alloc.c (TYPE_ALLOC_SIZE): Remove. * alloc.c (DECLARE_FIXED_TYPE_ALLOC): Remove. * alloc.c (ALLOCATE_FIXED_TYPE_FROM_BLOCK): Remove. * alloc.c (ALLOCATE_FIXED_TYPE_1): Remove. * alloc.c (ALLOCATE_FIXED_TYPE): Remove. * alloc.c (NOSEEUM_ALLOCATE_FIXED_TYPE): Remove. * alloc.c (struct Lisp_Free): Remove. * alloc.c (LRECORD_FREE_P): Remove. * alloc.c (MARK_LRECORD_AS_FREE): Remove. * alloc.c (MARK_LRECORD_AS_NOT_FREE): Remove. * alloc.c (PUT_FIXED_TYPE_ON_FREE_LIST): Remove. * alloc.c (FREE_FIXED_TYPE): Remove. * alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC): Remove. Allocate old lrecords with new allocator: * alloc.c: DECLARE_FIXED_TYPE_ALLOC removed for all lrecords defined in alloc.c. * alloc.c (Fcons): Allocate with new allocator. * alloc.c (noseeum_cons): Allocate with new allocator. * alloc.c (make_float): Allocate with new allocator. * alloc.c (make_bignum): Allocate with new allocator. * alloc.c (make_bignum_bg): Allocate with new allocator. * alloc.c (make_ratio): Allocate with new allocator. * alloc.c (make_ratio_bg): Allocate with new allocator. * alloc.c (make_ratio_rt): Allocate with new allocator. * alloc.c (make_bigfloat): Allocate with new allocator. * alloc.c (make_bigfloat_bf): Allocate with new allocator. * alloc.c (make_compiled_function): Allocate with new allocator. * alloc.c (Fmake_symbol): Allocate with new allocator. * alloc.c (allocate_extent): Allocate with new allocator. * alloc.c (allocate_event): Allocate with new allocator. * alloc.c (make_key_data): Allocate with new allocator. * alloc.c (make_button_data): Allocate with new allocator. * alloc.c (make_motion_data): Allocate with new allocator. * alloc.c (make_process_data): Allocate with new allocator. * alloc.c (make_timeout_data): Allocate with new allocator. * alloc.c (make_magic_data): Allocate with new allocator. * alloc.c (make_magic_eval_data): Allocate with new allocator. * alloc.c (make_eval_data): Allocate with new allocator. * alloc.c (make_misc_user_data): Allocate with new allocator. * alloc.c (Fmake_marker): Allocate with new allocator. * alloc.c (noseeum_make_marker): Allocate with new allocator. * alloc.c (make_uninit_string): Allocate with new allocator. * alloc.c (resize_string): Allocate with new allocator. * alloc.c (make_string_nocopy): Allocate with new allocator. Garbage Collection: * alloc.c (GC_CHECK_NOT_FREE): Remove obsolete assertions. * alloc.c (SWEEP_FIXED_TYPE_BLOCK): Remove. * alloc.c (SWEEP_FIXED_TYPE_BLOCK_1): Remove. * alloc.c (sweep_conses): Remove. * alloc.c (free_cons): Use new allocator to free. * alloc.c (sweep_compiled_functions): Remove. * alloc.c (sweep_floats): Remove. * alloc.c (sweep_bignums): Remove. * alloc.c (sweep_ratios): Remove. * alloc.c (sweep_bigfloats): Remove. * alloc.c (sweep_symbols): Remove. * alloc.c (sweep_extents): Remove. * alloc.c (sweep_events): Remove. * alloc.c (sweep_key_data): Remove. * alloc.c (free_key_data): Use new allocator to free. * alloc.c (sweep_button_data): Remove. * alloc.c (free_button_data): Use new allocator to free. * alloc.c (sweep_motion_data): Remove. * alloc.c (free_motion_data): Use new allocator to free. * alloc.c (sweep_process_data): Remove. * alloc.c (free_process_data): Use new allocator to free. * alloc.c (sweep_timeout_data): Remove. * alloc.c (free_timeout_data): Use new allocator to free. * alloc.c (sweep_magic_data): Remove. * alloc.c (free_magic_data): Use new allocator to free. * alloc.c (sweep_magic_eval_data): Remove. * alloc.c (free_magic_eval_data): Use new allocator to free. * alloc.c (sweep_eval_data): Remove. * alloc.c (free_eval_data): Use new allocator to free. * alloc.c (sweep_misc_user_data): Remove. * alloc.c (free_misc_user_data): Use new allocator to free. * alloc.c (sweep_markers): Remove. * alloc.c (free_marker): Use new allocator to free. * alloc.c (garbage_collect_1): Remove release_breathing_space. * alloc.c (gc_sweep): Remove all the old lcrecord and lrecord related stuff. Sweeping now works like this: compact string chars, finalize, sweep. * alloc.c (common_init_alloc_early): Remove old lrecord initializations, remove breathing_space. * emacs.c (Fdump_emacs): Remove release_breathing_space. * lisp.h: Remove prototype for release_breathing_space. * lisp.h: Adjust the special cons mark makros. Lrecord Finalizer: * alloc.c: Add finalizer to lrecord definition. * alloc.c (finalize_string): Add finalizer for string. * bytecode.c: Add finalizer to lrecord definition. * bytecode.c (finalize_compiled_function): Add finalizer for compiled function. * marker.c: Add finalizer to lrecord definition. * marker.c (finalize_marker): Add finalizer for marker. These changes build the interface to mc-alloc: * lrecord.h (MC_ALLOC_CALL_FINALIZER): Tell mc-alloc how to finalize lrecords. * lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE): Tell mc-alloc how to finalize for disksave. Unify lrecords and lcrecords: * lisp.h (struct Lisp_String): Adjust string union hack to new lrecord header. * lrecord.h: Adjust comments. * lrecord.h (struct lrecord_header): The new lrecord header includes type, lisp-readonly, free, and uid. * lrecord.h (set_lheader_implementation): Adjust to new lrecord_header. * lrecord.h (struct lrecord_implementation): The field basic_p for indication of an old lrecord is not needed anymore, remove. * lrecord.h (MAKE_LRECORD_IMPLEMENTATION): Remove basic_p. * lrecord.h (MAKE_EXTERNAL_LRECORD_IMPLEMENTATION): Remove basic_p. * lrecord.h (copy_sized_lrecord): Remove distinction between old lrecords and lcrecords. * lrecord.h (copy_lrecord): Remove distinction between old lrecords and lcrecords. * lrecord.h (zero_sized_lrecord): Remove distinction between old lrecords and lcrecords. * lrecord.h (zero_lrecord): Remove distinction between old lrecords and lcrecords. Remove lcrecords and lcrecord lists: * alloc.c (basic_alloc_lcrecord): Not needed anymore, remove. * alloc.c (very_old_free_lcrecord): Not needed anymore, remove. * alloc.c (copy_lisp_object): No more distinction between lrecords and lcrecords. * alloc.c (all_lcrecords): Not needed anymore, remove. * alloc.c (make_vector_internal): Allocate as lrecord. * alloc.c (make_bit_vector_internal): Allocate as lrecord. * alloc.c: Completely remove `lcrecord lists'. * alloc.c (free_description): Remove. * alloc.c (lcrecord_list_description): Remove. * alloc.c (mark_lcrecord_list): Remove. * alloc.c (make_lcrecord_list): Remove. * alloc.c (alloc_managed_lcrecord): Remove. * alloc.c (free_managed_lcrecord): Remove. * alloc.c (alloc_automanaged_lcrecord): Remove. * alloc.c (free_lcrecord): Remove. * alloc.c (lcrecord_stats): Remove. * alloc.c (tick_lcrecord_stats): Remove. * alloc.c (disksave_object_finalization_1): Add call to mc_finalize_for_disksave. Remove the lcrecord way to visit all objects. * alloc.c (kkcc_marking): Remove XD_FLAG_FREE_LISP_OBJECT * alloc.c (sweep_lcrecords_1): Remove. * alloc.c (common_init_alloc_early): Remove everything related to lcrecords, remove old lrecord initializations, * alloc.c (init_lcrecord_lists): Not needed anymore, remove. * alloc.c (reinit_alloc_early): Remove everything related to lcrecords. * alloc.c (init_alloc_once_early): Remove everything related to lcrecords. * buffer.c (allocate_buffer): Allocate as lrecord. * buffer.c (nuke_all_buffer_slots): Use lrecord functions. * buffer.c (common_init_complex_vars_of_buffer): Allocate as lrecord. * buffer.h (struct buffer): Add lrecord_header. * casetab.c (allocate_case_table): Allocate as lrecord. * casetab.h (struct Lisp_Case_Table): Add lrecord_header. * charset.h (struct Lisp_Charset): Add lrecord_header. * chartab.c (fill_char_table): Use lrecord functions. * chartab.c (Fmake_char_table): Allocate as lrecord. * chartab.c (make_char_table_entry): Allocate as lrecord. * chartab.c (copy_char_table_entry): Allocate as lrecord. * chartab.c (Fcopy_char_table): Allocate as lrecord. * chartab.c (put_char_table): Use lrecord functions. * chartab.h (struct Lisp_Char_Table_Entry): Add lrecord_header. * chartab.h (struct Lisp_Char_Table): Add lrecord_header. * console-impl.h (struct console): Add lrecord_header. * console-msw-impl.h (struct Lisp_Devmode): Add lrecord_header. * console-msw-impl.h (struct mswindows_dialog_id): Add lrecord_header. * console.c (allocate_console): Allocate as lrecord. * console.c (nuke_all_console_slots): Use lrecord functions. * console.c (common_init_complex_vars_of_console): Allocate as lrecord. * data.c (make_weak_list): Allocate as lrecord. * data.c (make_weak_box): Allocate as lrecord. * data.c (make_ephemeron): Allocate as lrecord. * database.c (struct Lisp_Database): Add lrecord_header. * database.c (allocate_database): Allocate as lrecord. * device-impl.h (struct device): Add lrecord_header. * device-msw.c (allocate_devmode): Allocate as lrecord. * device.c (nuke_all_device_slots): Use lrecord functions. * device.c (allocate_device): Allocate as lrecord. * dialog-msw.c (handle_question_dialog_box): Allocate as lrecord. * elhash.c (struct Lisp_Hash_Table): Add lrecord_header. * elhash.c (make_general_lisp_hash_table): Allocate as lrecord. * elhash.c (Fcopy_hash_table): Allocate as lrecord. * event-stream.c: Lcrecord lists Vcommand_builder_free_list and Vtimeout_free_list are no longer needed. Remove. * event-stream.c (allocate_command_builder): Allocate as lrecord. * event-stream.c (free_command_builder): Use lrecord functions. * event-stream.c (event_stream_generate_wakeup): Allocate as lrecord. * event-stream.c (event_stream_resignal_wakeup): Use lrecord functions. * event-stream.c (event_stream_disable_wakeup): Use lrecord functions. * event-stream.c (reinit_vars_of_event_stream): Lcrecord lists remove. * events.h (struct Lisp_Timeout): Add lrecord_header. * events.h (struct command_builder): Add lrecord_header. * extents-impl.h (struct extent_auxiliary): Add lrecord_header. * extents-impl.h (struct extent_info): Add lrecord_header. * extents.c (allocate_extent_auxiliary): Allocate as lrecord. * extents.c (allocate_extent_info): Allocate as lrecord. * extents.c (copy_extent): Allocate as lrecord. * faces.c (allocate_face): Allocate as lrecord. * faces.h (struct Lisp_Face): Add lrecord_header. * file-coding.c (allocate_coding_system): Allocate as lrecord. * file-coding.c (Fcopy_coding_system): Allocate as lrecord. * file-coding.h (struct Lisp_Coding_System): Add lrecord_header. * fns.c (Ffillarray): Allocate as lrecord. * frame-impl.h (struct frame): Add lrecord_header. * frame.c (nuke_all_frame_slots): Use lrecord functions. * frame.c (allocate_frame_core): Allocate as lrecord. * glyphs.c (allocate_image_instance): Allocate as lrecord. * glyphs.c (Fcolorize_image_instance): Allocate as lrecord. * glyphs.c (allocate_glyph): Allocate as lrecord. * glyphs.h (struct Lisp_Image_Instance): Add lrecord_header. * glyphs.h (struct Lisp_Glyph): Add lrecord_header. * gui.c (allocate_gui_item): Allocate as lrecord. * gui.h (struct Lisp_Gui_Item): Add lrecord_header. * keymap.c (struct Lisp_Keymap): Add lrecord_header. * keymap.c (make_keymap): Allocate as lrecord. * lisp.h (struct Lisp_Vector): Add lrecord_header. * lisp.h (struct Lisp_Bit_Vector): Add lrecord_header. * lisp.h (struct weak_box): Add lrecord_header. * lisp.h (struct ephemeron): Add lrecord_header. * lisp.h (struct weak_list): Add lrecord_header. * lrecord.h (struct lcrecord_header): Not used, remove. * lrecord.h (struct free_lcrecord_header): Not used, remove. * lrecord.h (struct lcrecord_list): Not needed anymore, remove. * lrecord.h (lcrecord_list): Not needed anymore, remove. * lrecord.h: (enum data_description_entry_flags): Remove XD_FLAG_FREE_LISP_OBJECT. * lstream.c: Lrecord list Vlstream_free_list remove. * lstream.c (Lstream_new): Allocate as lrecord. * lstream.c (Lstream_delete): Use lrecod functions. * lstream.c (reinit_vars_of_lstream): Vlstream_free_list initialization remove. * lstream.h (struct lstream): Add lrecord_header. * emacs.c (main_1): Remove lstream initialization. * mule-charset.c (make_charset): Allocate as lrecord. * objects-impl.h (struct Lisp_Color_Instance): Add lrecord_header. * objects-impl.h (struct Lisp_Font_Instance): Add lrecord_header. * objects.c (Fmake_color_instance): Allocate as lrecord. * objects.c (Fmake_font_instance): Allocate as lrecord. * objects.c (reinit_vars_of_objects): Allocate as lrecord. * opaque.c: Lcreord list Vopaque_ptr_list remove. * opaque.c (make_opaque): Allocate as lrecord. * opaque.c (make_opaque_ptr): Allocate as lrecord. * opaque.c (free_opaque_ptr): Use lrecord functions. * opaque.c (reinit_opaque_early): * opaque.c (init_opaque_once_early): Vopaque_ptr_list initialization remove. * opaque.h (Lisp_Opaque): Add lrecord_header. * opaque.h (Lisp_Opaque_Ptr): Add lrecord_header. * emacs.c (main_1): Remove opaque variable initialization. * print.c (default_object_printer): Use new lrecord_header. * print.c (print_internal): Use new lrecord_header. * print.c (debug_p4): Use new lrecord_header. * process.c (make_process_internal): Allocate as lrecord. * procimpl.h (struct Lisp_Process): Add lrecord_header. * rangetab.c (Fmake_range_table): Allocate as lrecord. * rangetab.c (Fcopy_range_table): Allocate as lrecord. * rangetab.h (struct Lisp_Range_Table): Add lrecord_header. * scrollbar.c (create_scrollbar_instance): Allocate as lrecord. * scrollbar.h (struct scrollbar_instance): Add lrecord_header. * specifier.c (make_specifier_internal): Allocate as lrecord. * specifier.h (struct Lisp_Specifier): Add lrecord_header. * symbols.c: * symbols.c (Fmake_variable_buffer_local): Allocate as lrecord. * symbols.c (Fdontusethis_set_symbol_value_handler): Allocate as lrecord. * symbols.c (Fdefvaralias): Allocate as lrecord. * symeval.h (struct symbol_value_magic): Add lrecord_header. * toolbar.c (update_toolbar_button): Allocate as lrecord. * toolbar.h (struct toolbar_button): Add lrecord_header. * tooltalk.c (struct Lisp_Tooltalk_Message): Add lrecord_header. * tooltalk.c (make_tooltalk_message): Allocate as lrecord. * tooltalk.c (struct Lisp_Tooltalk_Pattern): Add lrecord_header. * tooltalk.c (make_tooltalk_pattern): Allocate as lrecord. * ui-gtk.c (allocate_ffi_data): Allocate as lrecord. * ui-gtk.c (allocate_emacs_gtk_object_data): Allocate as lrecord. * ui-gtk.c (allocate_emacs_gtk_boxed_data): Allocate as lrecord. * ui-gtk.h (structs): Add lrecord_header. * window-impl.h (struct window): Add lrecord_header. * window-impl.h (struct window_mirror): Add lrecord_header. * window.c (allocate_window): Allocate as lrecord. * window.c (new_window_mirror): Allocate as lrecord. * window.c (make_dummy_parent): Allocate as lrecord. MEMORY_USAGE_STATS * alloc.c (fixed_type_block_overhead): Not used anymore, remove. * buffer.c (compute_buffer_usage): Get storage size from new allocator. * marker.c (compute_buffer_marker_usage): Get storage size from new allocator. * mule-charset.c (compute_charset_usage): Get storage size from new allocator. * scrollbar-gtk.c (gtk_compute_scrollbar_instance_usage): Get storage size from new allocator. * scrollbar-msw.c (mswindows_compute_scrollbar_instance_usage): Get storage size from new allocator. * scrollbar-x.c (x_compute_scrollbar_instance_usage): Get storage size from new allocator. * scrollbar.c (compute_scrollbar_instance_usage): Get storage size from new allocator. * unicode.c (compute_from_unicode_table_size_1): Get storage size from new allocator. * unicode.c (compute_to_unicode_table_size_1): Get storage size from new allocator. * window.c (compute_window_mirror_usage): Get storage size from new allocator. * window.c (compute_window_usage): Get storage size from new allocator. MC_ALLOC_TYPE_STATS: * alloc.c (alloc_lrecord): Bump lrecord count. * alloc.c (noseeum_alloc_lrecord): Bump lrecord count. * alloc.c (struct lrecord_stats): Storage for counts. * alloc.c (init_lrecord_stats): Zero statistics. * alloc.c (inc_lrecord_stats): Increase the statistic. * alloc.c (dec_lrecord_stats): Decrease the statistic. * alloc.c (gc_plist_hack): Used to print the information. * alloc.c (Fgarbage_collect): Return the collected information. * mc-alloc.c (remove_cell): Decrease lrecord count. * mc-alloc.h: Set flag MC_ALLOC_TYPE_STATS. * emacs.c (main_1): Init lrecord statistics. * lrecord.h: Add prototypes for *_lrecord_stats. Strings: * alloc.c (Fmake_string): Initialize ascii_begin to zero. * alloc.c (gc_count_num_short_string_in_use): Remove. * alloc.c (gc_count_string_total_size): Remove. * alloc.c (gc_count_short_string_total_size): Remove. * alloc.c (debug_string_purity): Remove. * alloc.c (debug_string_purity_print): Remove. * alloc.c (sweep_strings): Remove. Remove static C-readonly Lisp objects: * alloc.c (c_readonly): Not needed anymore, remove. * alloc.c (GC_CHECK_LHEADER_INVARIANTS): Remove some obsolete lheader invariants assertions. * buffer.c (DEFVAR_BUFFER_LOCAL_1): Allocate dynamically. * console.c (DEFVAR_CONSOLE_LOCAL_1): Allocate dynamically. * gpmevent.c: Indirection via MC_ALLOC_Freceive_gpm_event. * gpmevent.c (Fgpm_enable): Allocate dynamically. * gpmevent.c (syms_of_gpmevent): Allocate dynamically. * lisp.h (C_READONLY): Not needed anymore, remove. * lisp.h (DEFUN): Allocate dynamically. * lrecord.h (C_READONLY_RECORD_HEADER_P): Not needed anymore, remove. * lrecord.h (SET_C_READONLY_RECORD_HEADER): Not needed anymore, remove. * symbols.c (guts_of_unbound_marker): * symeval.h (defsubr): Allocate dynamically. * symeval.h (DEFSUBR_MACRO): Allocate dynamically. * symeval.h (DEFVAR_ SYMVAL_FWD): Allocate dynamically. * tests.c (TESTS_DEFSUBR): Allocate dynamically. Definition of mcpro: * lisp.h: Add mcpro prototypes. * alloc.c (common_init_alloc_early): Add initialization for mcpros. * alloc.c (mcpro_description_1): New. * alloc.c (mcpro_description): New. * alloc.c (mcpros_description_1): New. * alloc.c (mcpros_description): New. * alloc.c (mcpro_one_name_description_1): New. * alloc.c (mcpro_one_name_description): New. * alloc.c (mcpro_names_description_1): New. * alloc.c (mcpro_names_description): New. * alloc.c (mcpros): New. * alloc.c (mcpro_names): New. * alloc.c (mcpro_1): New. * alloc.c (mc_pro): New. * alloc.c (garbage_collect_1): Add mcpros to root set. Usage of mcpro: * alloc.c (make_string_nocopy): Add string to root set. * symbols.c (init_symbols_once_early): Add Qunbound to root set. Changes to the Portable Dumper: * alloc.c (FREE_OR_REALLOC_BEGIN): Since dumped objects can be freed with the new allocator, remove assertion for !DUMPEDP. * dumper.c: Adjust comments, increase PDUMP_HASHSIZE. * dumper.c (pdump_make_hash): Shift address only 2 bytes, to avoid collisions. * dumper.c (pdump_objects_unmark): No more mark bits within the object, remove. * dumper.c (mc_addr_elt): New. Element data structure for mc hash table. * dumper.c (pdump_mc_hash): New hash table: `lookup table'. * dumper.c (pdump_get_mc_addr): New. Lookup for hash table. * dumper.c (pdump_get_indirect_mc_addr): New. Lookup for convertibles. * dumper.c (pdump_put_mc_addr): New. Putter for hash table. * dumper.c (pdump_dump_mc_data): New. Writes the table for relocation at load time to the dump file. * dumper.c (pdump_scan_lisp_objects_by_alignment): New. Visits all dumped Lisp objects. * dumper.c (pdump_scan_non_lisp_objects_by_alignment): New. Visits all other dumped objects. * dumper.c (pdump_reloc_one_mc): New. Updates all pointers of an object by using the hash table pdump_mc_hash. * dumper.c (pdump_reloc_one): Replaced by pdump_reloc_one_mc. * dumper.c (pdump): Change the structure of the dump file, add the mc post dump relocation table to dump file. * dumper.c (pdump_load_finish): Hand all dumped objects to the new allocator and use the mc post dump relocation table for relocating the dumped objects at dump file load time, free not longer used data structures. * dumper.c (pdump_load): Free the dump file. * dumper.h: Remove pdump_objects_unmark. * lrecord.h (DUMPEDP): Dumped objects can be freed, remove. DUMP_IN_EXEC: * Makefile.in.in: Linking for and with dump in executable only if DUMP_IN_EXEC is defined. * config.h.in: Add new flag `DUMP_IN_EXEC' * emacs.c: Condition dump-data.h on DUMP_IN_EXEC. * emacs.c (main_1): Flag `-si' only works if dump image is written into executable. Miscellanious * lrecord.h (enum lrecord_type): Added numbers to all types, very handy for debugging. * xemacs.def.in.in: Add mc-alloc functions to make them visible to the modules. diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/configure mc-xemacs-21.5/configure --- xemacs-21.5/configure 2005-04-01 20:32:14.000000000 +0200 +++ mc-xemacs-21.5/configure 2005-04-01 20:26:01.000000000 +0200 ＠＠ -907,9 +907,13 ＠＠ Support XEmacs server for text widgets in other applications. --enable-kkcc Enable new GC algorithms. + --enable-mc-alloc Enable new allocator. --enable-union-type Use union definition of Lisp_Object type. Known to trigger bugs in some compilers. --enable-pdump Enable portable LISP preloader. + --enable-dump-in-exec Enable dumping into executable (enabled by default + for `pdump', not enabled by default in combination + with `mc-alloc'). --enable-debug Enable additional debugging information. No time cost. --enable-assertions ＠＠ -2133,6 +2137,11 ＠＠ enableval="$enable_kkcc" fi; +# Check whether --enable-mc-alloc or --disable-mc-alloc was given. +if test "${enable_mc_alloc+set}" = set; then + enableval="$enable_mc_alloc" + +fi; # Check whether --enable-union-type or --disable-union-type was given. if test "${enable_union_type+set}" = set; then enableval="$enable_union_type" ＠＠ -2143,6 +2152,11 ＠＠ enableval="$enable_pdump" fi; +# Check whether --enable-dump-in-exec or --disable-dump-in-exec was given. +if test "${enable_dump_in_exec+set}" = set; then + enableval="$enable_dump_in_exec" + +fi; # Check whether --enable-debug or --disable-debug was given. if test "${enable_debug+set}" = set; then enableval="$enable_debug" ＠＠ -7582,6 +7596,16 ＠＠ lib_gcc= fi +if test -z "$enable_dump_in_exec"; then + if test "$enable_pdump" = "yes"; then + if test "$enable_mc_alloc" = "yes"; then + enable_dump_in_exec=no + else + enable_dump_in_exec=yes + fi + fi +fi + test "$verbose" = "yes" && \ for var in libs_machine libs_system libs_termcap libs_standard objects_machine objects_system c_switch_machine c_switch_system ld_switch_machine ld_switch_system unexec ld_switch_shared ld lib_gcc ld_text_start_addr start_files ordinary_link have_terminfo mail_use_flock mail_use_lockf; do eval "echo \"$var = '\$$var'\""; done && echo "" ＠＠ -36353,6 +36377,10 ＠＠ #define USE_KKCC 1 _ACEOF +test "$enable_mc_alloc" = "yes" && cat >>confdefs.h <<\_ACEOF +#define MC_ALLOC 1 +_ACEOF + test "$enable_quick_build" = "yes" && cat >>confdefs.h <<\_ACEOF #define QUICK_BUILD 1 _ACEOF ＠＠ -36385,6 +36413,10 ＠＠ #define PDUMP 1 _ACEOF +test "$enable_dump_in_exec" = "yes" && cat >>confdefs.h <<\_ACEOF +#define DUMP_IN_EXEC 1 +_ACEOF + test "$with_ipv6_cname" = "yes" && cat >>confdefs.h <<\_ACEOF #define IPV6_CANONICALIZE 1 _ACEOF ＠＠ -36631,7 +36663,9 ＠＠ echo " WARNING: ---------------------------------------------------------" fi test "$enable_kkcc" = yes && echo " Using the new GC algorithms." +test "$enable_mc_alloc" = yes && echo " Using the new allocator." test "$enable_pdump" = yes && echo " Using the new portable dumper." +test "$enable_dump_in_exec" = yes && echo " Dumping into executable." test "$enable_debug" = yes && echo " Compiling in support for extra debugging code." test "$usage_tracking" = yes && echo " Compiling in support for active usage tracking (Sun internal)." if test "$enable_error_checking_extents $enable_error_checking_types $enable_error_checking_text $enable_error_checking_gc $enable_error_checking_malloc $enable_error_checking_glyphs $enable_error_checking_byte_code $enable_error_checking_display $enable_error_checking_structures" \ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/configure.ac mc-xemacs-21.5/configure.ac --- xemacs-21.5/configure.ac 2005-04-01 20:32:14.000000000 +0200 +++ mc-xemacs-21.5/configure.ac 2005-04-01 20:26:02.000000000 +0200 ＠＠ -708,12 +708,20 ＠＠ AC_ARG_ENABLE([kkcc], AC_HELP_STRING([--enable-kkcc],[Enable new GC algorithms.]), [], []) +AC_ARG_ENABLE([mc-alloc], + AC_HELP_STRING([--enable-mc-alloc],[Enable new allocator.]), + [], []) AC_ARG_ENABLE([union-type], AC_HELP_STRING([--enable-union-type],[Use union definition of Lisp_Object type. Known to trigger bugs in some compilers.]), [], []) AC_ARG_ENABLE([pdump], AC_HELP_STRING([--enable-pdump],[Enable portable LISP preloader.]), [], []) +AC_ARG_ENABLE([dump-in-exec], + AC_HELP_STRING([--enable-dump-in-exec],[Enable dumping into executable (enabled by default + for `pdump', not enabled by default in combination + with `mc-alloc').]), + [], []) AC_ARG_ENABLE([debug], AC_HELP_STRING([--enable-debug],[Enable additional debugging information. No time cost.]), [], []) ＠＠ -1983,6 +1991,17 ＠＠ lib_gcc= fi +dnl Dump into executable +if test -z "$enable_dump_in_exec"; then + if test "$enable_pdump" = "yes"; then + if test "$enable_mc_alloc" = "yes"; then + enable_dump_in_exec=no + else + enable_dump_in_exec=yes + fi + fi +fi + dnl For debugging... test "$verbose" = "yes" && \ PRINT_VAR(libs_machine libs_system libs_termcap libs_standard ＠＠ -5449,6 +5468,7 ＠＠ test "$GCC" = "yes" && AC_DEFINE(USE_GCC) test "$enable_external_widget" = "yes" && AC_DEFINE(EXTERNAL_WIDGET) test "$enable_kkcc" = "yes" && AC_DEFINE(USE_KKCC) +test "$enable_mc_alloc" = "yes" && AC_DEFINE(MC_ALLOC) test "$enable_quick_build" = "yes" && AC_DEFINE(QUICK_BUILD) test "$with_purify" = "yes" && AC_DEFINE(PURIFY) test "$with_quantify" = "yes" && AC_DEFINE(QUANTIFY) ＠＠ -5457,6 +5477,7 ＠＠ test "$with_hesiod" = "yes" && AC_DEFINE(HESIOD) test "$enable_union_type" = "yes" && AC_DEFINE(USE_UNION_TYPE) test "$enable_pdump" = "yes" && AC_DEFINE(PDUMP) +test "$enable_dump_in_exec" = "yes" && AC_DEFINE(DUMP_IN_EXEC) test "$with_ipv6_cname" = "yes" && AC_DEFINE(IPV6_CANONICALIZE) ＠＠ -5709,7 +5730,9 ＠＠ echo " WARNING: ---------------------------------------------------------" fi test "$enable_kkcc" = yes && echo " Using the new GC algorithms." +test "$enable_mc_alloc" = yes && echo " Using the new allocator." test "$enable_pdump" = yes && echo " Using the new portable dumper." +test "$enable_dump_in_exec" = yes && echo " Dumping into executable." test "$enable_debug" = yes && echo " Compiling in support for extra debugging code." test "$usage_tracking" = yes && echo " Compiling in support for active usage tracking (Sun internal)." if test "$enable_error_checking_extents $enable_error_checking_types $enable_error_checking_text $enable_error_checking_gc $enable_error_checking_malloc $enable_error_checking_glyphs $enable_error_checking_byte_code $enable_error_checking_display $enable_error_checking_structures" \ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/configure.in mc-xemacs-21.5/configure.in --- xemacs-21.5/configure.in 2005-03-02 02:09:04.000000000 +0100 +++ mc-xemacs-21.5/configure.in 2005-03-19 03:19:09.000000000 +0100 ＠＠ -535,11 +535,13 ＠＠ with_ipv6_cname | \ external_widget | \ use_kkcc | \ + mc_alloc | \ verbose | \ extra_verbose | \ usage_tracking | \ use_union_type | \ pdump | \ + dump_in_exec | \ debug | \ use_assertions | \ memory_usage_stats | \ ＠＠ -1612,6 +1614,17 ＠＠ esac fi +dnl Dump into executable +if test -z "$dump_in_exec"; then + if test "$pdump" = "yes"; then + if test "$mc_alloc" = "yes"; then + dump_in_exec=no + else + dump_in_exec=yes + fi + fi +fi + if test -z "$dynamic"; then case "$opsys" in hpux* | sunos4* ) dynamic=no ;; ＠＠ -5457,6 +5470,7 ＠＠ test "$GCC" = "yes" && AC_DEFINE(USE_GCC) test "$external_widget" = "yes" && AC_DEFINE(EXTERNAL_WIDGET) test "$use_kkcc" = "yes" && AC_DEFINE(USE_KKCC) +test "$mc_alloc" = "yes" && AC_DEFINE(MC_ALLOC) test "$quick_build" = "yes" && AC_DEFINE(QUICK_BUILD) test "$with_purify" = "yes" && AC_DEFINE(PURIFY) test "$with_quantify" = "yes" && AC_DEFINE(QUANTIFY) ＠＠ -5465,6 +5479,7 ＠＠ test "$with_hesiod" = "yes" && AC_DEFINE(HESIOD) test "$use_union_type" = "yes" && AC_DEFINE(USE_UNION_TYPE) test "$pdump" = "yes" && AC_DEFINE(PDUMP) +test "$dump_in_exec" = "yes" && AC_DEFINE(DUMP_IN_EXEC) test "$with_ipv6_cname" = "yes" && AC_DEFINE(IPV6_CANONICALIZE) dnl ------------------------------- ＠＠ -5708,7 +5723,9 ＠＠ echo " WARNING: ---------------------------------------------------------" fi test "$use_kkcc" = yes && echo " Using the new GC algorithms." +test "$mc_alloc" = yes && echo " Using the new allocator." test "$pdump" = yes && echo " Using the new portable dumper." +test "$dump_in_exec" = yes && echo " Dumping into executable." test "$debug" = yes && echo " Compiling in support for extra debugging code." test "$usage_tracking" = yes && echo " Compiling in support for active usage tracking (Sun internal)." if test "$error_check_extents $error_check_types $error_check_text $error_check_gc $error_check_malloc $error_check_glyphs $error_check_byte_code $error_check_display $error_check_structures" \ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/configure.usage mc-xemacs-21.5/configure.usage --- xemacs-21.5/configure.usage 2005-01-26 14:30:06.000000000 +0100 +++ mc-xemacs-21.5/configure.usage 2005-03-19 20:00:17.000000000 +0100 ＠＠ -382,7 +382,11 ＠＠ might say. (Infamous for being the former "experimental, don't-sue-me-if-your-house-collapses- and-your-wife-leaves-you" portable dumper.) +--dump-in-exec Put the dump image into the executable (enabled by + default for `pdump', not enabled by default in + combination with `mc-alloc'. --use-kkcc Enable the use of new GC algorithms. (EXPERIMENTAL) +--mc-alloc Enable the new allocator. (EXPERIMENTAL) --with-modules (*) Compile in experimental support for dynamically loaded libraries (Dynamic Shared Objects). diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/lib-src/Makefile.in.in mc-xemacs-21.5/lib-src/Makefile.in.in --- xemacs-21.5/lib-src/Makefile.in.in 2004-07-03 01:08:37.000000000 +0200 +++ mc-xemacs-21.5/lib-src/Makefile.in.in 2005-03-19 17:50:49.000000000 +0100 ＠＠ -129,7 +129,11 ＠＠ ## Things that XEmacs uses during the build process itself. ## Not installed. +#ifdef DUMP_IN_EXEC BUILD_UTILITIES = make-path make-dump-id insert-data-in-exec +#else +BUILD_UTILITIES = make-path make-dump-id +#endif EXES = ${PUBLIC_INSTALLABLE_EXES} ${PRIVATE_INSTALLABLE_EXES} ${BUILD_UTILITIES} SCRIPTS = ${PUBLIC_INSTALLABLE_SCRIPTS} ${PRIVATE_INSTALLABLE_SCRIPTS} ＠＠ -375,8 +379,10 ＠＠ make-dump-id: ${srcdir}/make-dump-id.c $(CC) $(cflags) ${srcdir}/make-dump-id.c $(ldflags) -o $＠ +#ifndef DUMP_IN_EXEC insert-data-in-exec: ${srcdir}/insert-data-in-exec.c $(CC) $(cflags) ${srcdir}/insert-data-in-exec.c $(ldflags) -o $＠ +#endif /* not DUMP_IN_EXEC */ cflags_gnuserv = $(CFLAGS) $(cppflags) $(c_switch_all) ldflags_gnuserv = $(LDFLAGS) $(ld_switch_all) ＠libs_xauth＠ $(ld_libs_general) diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/lisp/diagnose.el mc-xemacs-21.5/lisp/diagnose.el --- xemacs-21.5/lisp/diagnose.el 2005-03-01 01:11:54.000000000 +0100 +++ mc-xemacs-21.5/lisp/diagnose.el 2005-03-02 21:35:33.000000000 +0100 ＠＠ -163,3 +163,159 ＠＠ (princ (format "\n\ngrand total: %s\n" grandtotal))) grandtotal)))) + + +(defun show-mc-alloc-memory-usage () + "Show statistics about memory usage of the new allocator." + (interactive) + (garbage-collect) + (let* ((stats (mc-alloc-memory-usage)) + (page-size (first stats)) + (heap-sects (second stats)) + (used-plhs (third stats)) + (unmanaged-plhs (fourth stats)) + (free-plhs (fifth stats)) + (globals (sixth stats)) + (mc-malloced-bytes (seventh stats))) + (with-output-to-temp-buffer "*memory usage*" + (flet ((print-used-plhs (text plhs) + (let ((sum-n-pages 0) + (sum-used-n-cells 0) + (sum-used-space 0) + (sum-used-total 0) + (sum-total-n-cells 0) + (sum-total-space 0) + (sum-total-total 0) + (fmt "%7s%7s|%7s%9s%9s%4s|%7s%9s%9s%4s|%4s\n")) + (princ (format "%-14s|%-29s|%-29s|\n" + text + " currently in use" + " total available")) + (princ (format fmt "cell-sz" "#pages" + "#cells" "space" "total" "% " + "#cells" "space" "total" "% " "% ")) + (princ (make-string 79 ?-)) + (princ "\n") + (while plhs + (let* ((elem (car plhs)) + (cell-size (first elem)) + (n-pages (second elem)) + (used-n-cells (third elem)) + (used-space (fourth elem)) + (used-total (if (zerop cell-size) + (sixth elem) + (* cell-size used-n-cells))) + (used-eff (floor (if (not (zerop used-total)) + (* (/ (* used-space 1.0) + (* used-total 1.0)) + 100.0) + 0))) + (total-n-cells (fifth elem)) + (total-space (if (zerop cell-size) + used-space + (* cell-size total-n-cells))) + (total-total (sixth elem)) + (total-eff (floor (if (not (zerop total-total)) + (* (/ (* total-space 1.0) + (* total-total 1.0)) + 100.0) + 0))) + (eff (floor (if (not (zerop total-total)) + (* (/ (* used-space 1.0) + (* total-total 1.0)) + 100.0) + 0)))) + (princ (format fmt + cell-size n-pages used-n-cells used-space + used-total used-eff total-n-cells + total-space total-total total-eff eff)) + (incf sum-n-pages n-pages) + (incf sum-used-n-cells used-n-cells) + (incf sum-used-space used-space) + (incf sum-used-total used-total) + (incf sum-total-n-cells total-n-cells) + (incf sum-total-space total-space) + (incf sum-total-total total-total)) + (setq plhs (cdr plhs))) + (let ((avg-used-eff (floor (if (not (zerop sum-used-total)) + (* (/ (* sum-used-space 1.0) + (* sum-used-total 1.0)) + 100.0) + 0))) + (avg-total-eff (floor (if (not (zerop sum-total-total)) + (* (/ (* sum-total-space 1.0) + (* sum-total-total 1.0)) + 100.0) + 0))) + (avg-eff (floor (if (not (zerop sum-total-total)) + (* (/ (* sum-used-space 1.0) + (* sum-total-total 1.0)) + 100.0) + 0)))) + (princ (format fmt "sum " sum-n-pages sum-used-n-cells + sum-used-space sum-used-total avg-used-eff + sum-total-n-cells sum-total-space + sum-total-total avg-total-eff avg-eff)) + (princ "\n")))) + + + (print-free-plhs (text plhs) + (let ((sum-n-pages 0) + (sum-n-sects 0) + (sum-space 0) + (sum-total 0) + (fmt "%6s%10s |%7s%10s\n")) + (princ (format "%s\n" text)) + (princ (format fmt "#pages" "space" "#sects" "total")) + (princ (make-string 35 ?-)) + (princ "\n") + (while plhs + (let* ((elem (car plhs)) + (n-pages (first elem)) + (n-sects (second elem)) + (space (* n-pages page-size)) + (total (* n-sects space))) + (princ (format fmt n-pages space n-sects total)) + (incf sum-n-pages n-pages) + (incf sum-n-sects n-sects) + (incf sum-space space) + (incf sum-total total)) + (setq plhs (cdr plhs))) + (princ (make-string 35 ?=)) + (princ "\n") + (princ (format fmt sum-n-pages sum-space + sum-n-sects sum-total)) + (princ "\n")))) + + (princ (format "%-12s%10s\n\n" "PAGE_SIZE" page-size)) + + (print-used-plhs "USED HEAP" used-plhs) + (princ "\n\n") + + (print-used-plhs "UNMANAGED HEAP" unmanaged-plhs) + (princ "\n\n") + + (print-free-plhs "FREE HEAP" free-plhs) + (princ "\n\n") + + (let ((fmt "%-30s%10s\n")) + (princ (format fmt "heap sections" "")) + (princ (make-string 40 ?-)) + (princ "\n") + (princ (format fmt "number of heap sects" + (first heap-sects))) + (princ (format fmt "used size" (second heap-sects))) + (princ (make-string 40 ?-)) + (princ "\n") + (princ (format fmt "real size" (third heap-sects))) + (princ (format fmt "global allocator structs" globals)) + (princ (make-string 40 ?-)) + (princ "\n") + (princ (format fmt "real size + structs" + (+ (third heap-sects) globals))) + (princ "\n") + (princ (make-string 40 ?=)) + (princ "\n") + (princ (format fmt "grand total" mc-malloced-bytes))) + + (+ mc-malloced-bytes))))) diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/Makefile.in.in mc-xemacs-21.5/Makefile.in.in --- xemacs-21.5/Makefile.in.in 2005-02-03 01:59:49.000000000 +0100 +++ mc-xemacs-21.5/Makefile.in.in 2005-03-19 02:52:54.000000000 +0100 ＠＠ -388,7 +388,7 ＠＠ for subdir in `find ${archlibdir} -type d ! -name RCS ! -name SCCS ! -name CVS -print` ; \ do (cd $${subdir} && $(RM) -r RCS CVS SCCS \#* *~) ; done ; \ else true; fi -#if defined(PDUMP) && defined(WIN32_NATIVE) +#if (defined(PDUMP) && !defined (DUMP_IN_EXEC)) || (defined (PDUMP) && defined(WIN32_NATIVE)) ${INSTALL_DATA} src/${PROGNAME}.dmp ${bindir}/${PROGNAME}-${version}-`src/${PROGNAME} -sd`.dmp #endif #ifdef WIN32_NATIVE diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/modules/ldap/eldap.c mc-xemacs-21.5/modules/ldap/eldap.c --- xemacs-21.5/modules/ldap/eldap.c 2004-11-14 13:04:05.000000000 +0100 +++ mc-xemacs-21.5/modules/ldap/eldap.c 2005-02-01 22:58:33.000000000 +0100 ＠＠ -141,7 +141,11 ＠＠ static Lisp_LDAP * allocate_ldap (void) { +#ifdef MC_ALLOC + Lisp_LDAP *ldap = alloc_lrecord_type (Lisp_LDAP, &lrecord_ldap); +#else /* not MC_ALLOC */ Lisp_LDAP *ldap = alloc_lcrecord_type (Lisp_LDAP, &lrecord_ldap); +#endif /* not MC_ALLOC */ ldap->ld = NULL; ldap->host = Qnil; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/modules/ldap/eldap.h mc-xemacs-21.5/modules/ldap/eldap.h --- xemacs-21.5/modules/ldap/eldap.h 2002-09-10 17:27:14.000000000 +0200 +++ mc-xemacs-21.5/modules/ldap/eldap.h 2005-02-01 22:58:33.000000000 +0100 ＠＠ -31,8 +31,13 ＠＠ struct Lisp_LDAP { +#ifdef MC_ALLOC + /* lrecord header */ + struct lrecord_header header; +#else /* not MC_ALLOC */ /* lcrecord header */ struct lcrecord_header header; +#endif /* not MC_ALLOC */ /* The LDAP connection handle used by the LDAP API */ LDAP *ld; /* Name of the host we connected to */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/modules/postgresql/postgresql.c mc-xemacs-21.5/modules/postgresql/postgresql.c --- xemacs-21.5/modules/postgresql/postgresql.c 2004-09-23 23:39:38.000000000 +0200 +++ mc-xemacs-21.5/modules/postgresql/postgresql.c 2005-02-01 22:58:33.000000000 +0100 ＠＠ -238,11 +238,21 ＠＠ allocate_pgconn (void) { #ifdef RUNNING_XEMACS_21_1 +#ifdef MC_ALLOC + Lisp_PGconn *pgconn = alloc_lrecord_type (Lisp_PGconn, + lrecord_pgconn); +#else /* not MC_ALLOC */ Lisp_PGconn *pgconn = alloc_lcrecord_type (Lisp_PGconn, lrecord_pgconn); +#endif /* not MC_ALLOC */ #else +#ifdef MC_ALLOC + Lisp_PGconn *pgconn = alloc_lrecord_type (Lisp_PGconn, + &lrecord_pgconn); +#else /* not MC_ALLOC */ Lisp_PGconn *pgconn = alloc_lcrecord_type (Lisp_PGconn, &lrecord_pgconn); +#endif /* not MC_ALLOC */ #endif pgconn->pgconn = (PGconn *)NULL; return pgconn; ＠＠ -363,11 +373,21 ＠＠ allocate_pgresult (void) { #ifdef RUNNING_XEMACS_21_1 +#ifdef MC_ALLOC + Lisp_PGresult *pgresult = alloc_lrecord_type (Lisp_PGresult, + lrecord_pgresult); +#else /* not MC_ALLOC */ Lisp_PGresult *pgresult = alloc_lcrecord_type (Lisp_PGresult, lrecord_pgresult); +#endif /* not MC_ALLOC */ #else +#ifdef MC_ALLOC + Lisp_PGresult *pgresult = alloc_lrecord_type (Lisp_PGresult, + &lrecord_pgresult); +#else /* not MC_ALLOC */ Lisp_PGresult *pgresult = alloc_lcrecord_type (Lisp_PGresult, &lrecord_pgresult); +#endif /* not MC_ALLOC */ #endif pgresult->pgresult = (PGresult *)NULL; return pgresult; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/modules/postgresql/postgresql.h mc-xemacs-21.5/modules/postgresql/postgresql.h --- xemacs-21.5/modules/postgresql/postgresql.h 2002-09-10 17:27:18.000000000 +0200 +++ mc-xemacs-21.5/modules/postgresql/postgresql.h 2005-02-01 22:58:33.000000000 +0100 ＠＠ -28,7 +28,11 ＠＠ */ struct Lisp_PGconn { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* not MC_ALLOC */ struct lcrecord_header header; +#endif /* not MC_ALLOC */ PGconn *pgconn; }; typedef struct Lisp_PGconn Lisp_PGconn; ＠＠ -48,7 +52,11 ＠＠ */ struct Lisp_PGresult { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* not MC_ALLOC */ struct lcrecord_header header; +#endif /* not MC_ALLOC */ PGresult *pgresult; }; typedef struct Lisp_PGresult Lisp_PGresult; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/nt/config.inc.samp mc-xemacs-21.5/nt/config.inc.samp --- xemacs-21.5/nt/config.inc.samp 2005-02-07 12:21:54.000000000 +0100 +++ mc-xemacs-21.5/nt/config.inc.samp 2005-02-07 12:34:09.000000000 +0100 ＠＠ -180,6 +180,9 ＠＠ # of the traditional XEmacs garbage-collection routines. USE_KKCC=0 +# Set this to use the new experimental allocator routines +MC_ALLOC=0 + # Set this to turn on the use of the union type, which gets you improved # type checking of Lisp_Objects -- they're declared as unions instead of # ints, and so places where a Lisp_Object is mistakenly passed to a routine diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/nt/xemacs.dsp mc-xemacs-21.5/nt/xemacs.dsp --- xemacs-21.5/nt/xemacs.dsp 2004-09-15 09:01:10.000000000 +0200 +++ mc-xemacs-21.5/nt/xemacs.dsp 2005-03-19 18:16:39.000000000 +0100 ＠＠ -787,6 +787,14 ＠＠ # End Source File # Begin Source File +SOURCE=..\src\mc-alloc.c +# End Source File +# Begin Source File + +SOURCE=..\src\mc-alloc.h +# End Source File +# Begin Source File + SOURCE=..\src\md5.c # End Source File # Begin Source File diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/nt/xemacs.mak mc-xemacs-21.5/nt/xemacs.mak --- xemacs-21.5/nt/xemacs.mak 2005-02-25 02:16:43.000000000 +0100 +++ mc-xemacs-21.5/nt/xemacs.mak 2005-03-02 21:35:43.000000000 +0100 ＠＠ -184,6 +184,9 ＠＠ !if !defined(USE_KKCC) USE_KKCC=0 !endif +!if !defined(MC_ALLOC) +MC_ALLOC=0 +!endif !if !defined(USE_UNION_TYPE) USE_UNION_TYPE=0 !endif ＠＠ -503,6 +506,11 ＠＠ KKCC_DEFINES=-DUSE_KKCC !endif +!if $(MC_ALLOC) +MC_ALLOC_DEFINES=-DMC_ALLOC +TEMACS_MC_ALLOC_OBJS=$(OUTDIR)\mc-alloc.obj +!endif + !if $(USE_SYSTEM_MALLOC) MALLOC_DEFINES=-DSYSTEM_MALLOC !else ＠＠ -605,9 +613,9 ＠＠ INCLUDES=-I$(NT)\inc -I$(SRC) $(MSW_INCLUDES) DEFINES=$(MSW_DEFINES) $(MULE_DEFINES) $(UNION_DEFINES) \ - $(DUMPER_DEFINES) $(KKCC_DEFINES) $(MALLOC_DEFINES) \ - $(QUICK_DEFINES) $(ERROR_CHECK_DEFINES) $(DEBUG_DEFINES) \ - -DWIN32_LEAN_AND_MEAN -DWIN32_NATIVE -Demacs \ + $(DUMPER_DEFINES) $(KKCC_DEFINES) $(MC_ALLOC_DEFINES) \ + $(MALLOC_DEFINES) $(QUICK_DEFINES) $(ERROR_CHECK_DEFINES) \ + $(DEBUG_DEFINES) -DWIN32_LEAN_AND_MEAN -DWIN32_NATIVE -Demacs \ -DHAVE_CONFIG_H $(PROGRAM_DEFINES) $(PATH_DEFINES) CFLAGS_NO_OPT=-nologo -W3 -DSTRICT $(DEBUG_FLAGS_COMPILE) ＠＠ -651,6 +659,7 ＠＠ $(TEMACS_DEBUG_OBJS)\ $(TEMACS_ALLOC_OBJS)\ $(TEMACS_DUMP_OBJS)\ + $(TEMACS_MC_ALLOC_OBJS)\ $(OUTDIR)\abbrev.obj \ $(OUTDIR)\alloc.obj \ $(OUTDIR)\alloca.obj \ ＠＠ -1241,6 +1250,9 ＠＠ !if $(USE_KKCC) Using new experimental GC algorithms. !endif +!if $(MC_ALLOC) + Using new experimental allocator. +!endif <<NOKEEP ＠echo -------------------------------------------------------------------- ＠type $(BLDROOT)\Installation diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/alloc.c mc-xemacs-21.5/src/alloc.c --- xemacs-21.5/src/alloc.c 2005-03-14 00:38:23.000000000 +0100 +++ mc-xemacs-21.5/src/alloc.c 2005-03-29 22:18:41.000000000 +0200 ＠＠ -220,11 +220,13 ＠＠ void *minimum_address_seen; void *maximum_address_seen; +#ifndef MC_ALLOC int c_readonly (Lisp_Object obj) { return POINTER_TYPE_P (XTYPE (obj)) && C_READONLY (obj); } +#endif /* MC_ALLOC */ int lisp_readonly (Lisp_Object obj) ＠＠ -243,6 +245,7 ＠＠ int ignore_malloc_warnings; +#ifndef MC_ALLOC static void *breathing_space; void ＠＠ -255,6 +258,7 ＠＠ xfree (tmp, void *); } } +#endif /* not MC_ALLOC */ /* malloc calls this if it finds we are near exhausting storage */ void ＠＠ -282,7 +286,9 ＠＠ */ consing_since_gc = gc_cons_threshold + 1; recompute_need_to_garbage_collect (); +#ifndef MC_ALLOC release_breathing_space (); +#endif /* not MC_ALLOC */ /* Flush some histories which might conceivably contain garbalogical inhibitors. */ ＠＠ -324,6 +330,18 ＠＠ } \ while (0) +#ifdef MC_ALLOC +#define FREE_OR_REALLOC_BEGIN(block) \ +do \ +{ \ + /* Unbelievably, calling free() on 0xDEADBEEF doesn't cause an \ + error until much later on for many system mallocs, such as \ + the one that comes with Solaris 2.3. FMH!! */ \ + assert (block != (void *) 0xDEADBEEF); \ + MALLOC_BEGIN (); \ +} \ +while (0) +#else /* not MC_ALLOC */ #define FREE_OR_REALLOC_BEGIN(block) \ do \ { \ ＠＠ -339,6 +357,7 ＠＠ MALLOC_BEGIN (); \ } \ while (0) +#endif /* not MC_ALLOC */ #define MALLOC_END() \ do \ ＠＠ -424,6 +443,7 ＠＠ #ifdef ERROR_CHECK_GC +#ifndef MC_ALLOC static void deadbeef_memory (void *ptr, Bytecount size) { ＠＠ -434,6 +454,7 ＠＠ while (beefs--) (*ptr4++) = 0xDEADBEEF; /* -559038737 base 10 */ } +#endif /* not MC_ALLOC */ #else /* !ERROR_CHECK_GC */ ＠＠ -462,6 +483,7 ＠＠ #endif /* NEED_STRDUP */ +#ifndef MC_ALLOC static void * allocate_lisp_storage (Bytecount size) { ＠＠ -486,12 +508,119 ＠＠ return val; } +#endif /* not MC_ALLOC */ + +#ifdef MC_ALLOC_TYPE_STATS +static struct +{ + int instances_in_use; + int bytes_in_use; + int bytes_in_use_including_overhead; +} lrecord_stats [countof (lrecord_implementations_table) + + MODULE_DEFINABLE_TYPE_COUNT]; + +void +init_lrecord_stats () +{ + xzero (lrecord_stats); +} + +void +inc_lrecord_stats (Bytecount size, const struct lrecord_header *h) +{ + int type_index = h->type; + if (!size) + size = detagged_lisp_object_size (h); + + lrecord_stats[type_index].instances_in_use++; + lrecord_stats[type_index].bytes_in_use += size; + lrecord_stats[type_index].bytes_in_use_including_overhead +#ifdef MEMORY_USAGE_STATS + += mc_alloced_storage_size (size, 0); +#else /* not MEMORY_USAGE_STATS */ + += size; +#endif /* not MEMORY_USAGE_STATS */ +} + +void +dec_lrecord_stats (Bytecount size_including_overhead, + const struct lrecord_header *h) +{ + int type_index = h->type; + lrecord_stats[type_index].instances_in_use--; + lrecord_stats[type_index].bytes_in_use -= detagged_lisp_object_size (h); + lrecord_stats[type_index].bytes_in_use_including_overhead + -= size_including_overhead; + DECREMENT_CONS_COUNTER (lrecord_stats[type_index].bytes_in_use); +} +#endif /* not MC_ALLOC_TYPE_STATS */ + +#ifndef MC_ALLOC /* lcrecords are chained together through their "next" field. After doing the mark phase, GC will walk this linked list and free any lcrecord which hasn't been marked. */ static struct lcrecord_header *all_lcrecords; +#endif /* not MC_ALLOC */ + +#ifdef MC_ALLOC +/* The basic lrecord allocation functions. See lrecord.h for details. */ +void * +alloc_lrecord (Bytecount size, + const struct lrecord_implementation *implementation) +{ + 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); + lheader->uid = lrecord_uid_counter++; +#ifdef MC_ALLOC_TYPE_STATS + inc_lrecord_stats (size, lheader); +#endif /* not MC_ALLOC_TYPE_STATS */ + INCREMENT_CONS_COUNTER (size, implementation->name); + return lheader; +} + +void * +noseeum_alloc_lrecord (Bytecount size, + const struct lrecord_implementation *implementation) +{ + struct lrecord_header *lheader; + + type_checking_assert + ((implementation->static_size == 0 ? + implementation->size_in_bytes_method != NULL : + implementation->static_size == size)); + + lheader = (struct lrecord_header *) mc_alloc (size); + gc_checking_assert (LRECORD_FREE_P (lheader)); + set_lheader_implementation (lheader, implementation); + lheader->uid = lrecord_uid_counter++; +#ifdef MC_ALLOC_TYPE_STATS + inc_lrecord_stats (size, lheader); +#endif /* not MC_ALLOC_TYPE_STATS */ + NOSEEUM_INCREMENT_CONS_COUNTER (size, implementation->name); + return lheader; +} + +void +free_lrecord (Lisp_Object lrecord) +{ + gc_checking_assert (!gc_in_progress); + gc_checking_assert (!LRECORD_FREE_P (XRECORD_LHEADER (lrecord))); + gc_checking_assert (!XRECORD_LHEADER (lrecord)->free); + + MC_ALLOC_CALL_FINALIZER (XPNTR (lrecord)); + mc_free (XPNTR (lrecord)); +} +#else /* not MC_ALLOC */ /* The most basic of the lcrecord allocation functions. Not usually called directly. Allocates an lrecord not managed by any lcrecord-list, of a ＠＠ -563,11 +692,15 ＠＠ return; } #endif /* Unused */ +#endif /* not MC_ALLOC */ static void disksave_object_finalization_1 (void) { +#ifdef MC_ALLOC + mc_finalize_for_disksave (); +#else /* not MC_ALLOC */ struct lcrecord_header *header; for (header = all_lcrecords; header; header = header->next) ＠＠ -576,6 +709,7 ＠＠ !header->free) LHEADER_IMPLEMENTATION (&header->lheader)->finalizer (header, 1); } +#endif /* not MC_ALLOC */ } /* Bitwise copy all parts of a Lisp object other than the header */ ＠＠ -590,6 +724,11 ＠＠ assert (imp == XRECORD_LHEADER_IMPLEMENTATION (dst)); assert (size == lisp_object_size (dst)); +#ifdef MC_ALLOC + memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header), + (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header), + size - sizeof (struct lrecord_header)); +#else /* not MC_ALLOC */ if (imp->basic_p) memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header), (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header), ＠＠ -598,6 +737,7 ＠＠ memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lcrecord_header), (char *) XRECORD_LHEADER (src) + sizeof (struct lcrecord_header), size - sizeof (struct lcrecord_header)); +#endif /* not MC_ALLOC */ } ＠＠ -645,6 +785,7 ＠＠ } +#ifndef MC_ALLOC /************************************************************************/ /* Fixed-size type macros */ /************************************************************************/ ＠＠ -1003,6 +1144,7 ＠＠ #else #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr) #endif +#endif /* not MC_ALLOC */ ＠＠ -1010,10 +1152,12 ＠＠ /* Cons allocation */ /************************************************************************/ +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (cons, Lisp_Cons); /* conses are used and freed so often that we set this really high */ /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 20000 */ #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 2000 +#endif /* not MC_ALLOC */ static Lisp_Object mark_cons (Lisp_Object obj) ＠＠ -1067,8 +1211,12 ＠＠ Lisp_Object val; Lisp_Cons *c; +#ifdef MC_ALLOC + c = alloc_lrecord_type (Lisp_Cons, &lrecord_cons); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (cons, Lisp_Cons, c); set_lheader_implementation (&c->lheader, &lrecord_cons); +#endif /* not MC_ALLOC */ val = wrap_cons (c); XSETCAR (val, car); XSETCDR (val, cdr); ＠＠ -1084,8 +1232,12 ＠＠ Lisp_Object val; Lisp_Cons *c; +#ifdef MC_ALLOC + c = noseeum_alloc_lrecord_type (Lisp_Cons, &lrecord_cons); +#else /* not MC_ALLOC */ NOSEEUM_ALLOCATE_FIXED_TYPE (cons, Lisp_Cons, c); set_lheader_implementation (&c->lheader, &lrecord_cons); +#endif /* not MC_ALLOC */ val = wrap_cons (c); XCAR (val) = car; XCDR (val) = cdr; ＠＠ -1187,19 +1339,25 ＠＠ /*** With enhanced number support, these are short floats */ +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (float, Lisp_Float); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_float 1000 +#endif /* not MC_ALLOC */ Lisp_Object make_float (double float_value) { Lisp_Float *f; +#ifdef MC_ALLOC + f = alloc_lrecord_type (Lisp_Float, &lrecord_float); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (float, Lisp_Float, f); /* Avoid dump-time `uninitialized memory read' purify warnings. */ if (sizeof (struct lrecord_header) + sizeof (double) != sizeof (*f)) xzero (*f); +#endif /* not MC_ALLOC */ set_lheader_implementation (&f->lheader, &lrecord_float); float_data (f) = float_value; ＠＠ -1213,8 +1371,10 ＠＠ /*** Bignum ***/ #ifdef HAVE_BIGNUM +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (bignum, Lisp_Bignum); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_bignum 250 +#endif /* not MC_ALLOC */ /* WARNING: This function returns a bignum even if its argument fits into a fixnum. See Fcanonicalize_number(). */ ＠＠ -1223,8 +1383,12 ＠＠ { Lisp_Bignum *b; +#ifdef MC_ALLOC + b = alloc_lrecord_type (Lisp_Bignum, &lrecord_bignum); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (bignum, Lisp_Bignum, b); set_lheader_implementation (&b->lheader, &lrecord_bignum); +#endif /* not MC_ALLOC */ bignum_init (bignum_data (b)); bignum_set_long (bignum_data (b), bignum_value); return wrap_bignum (b); ＠＠ -1237,8 +1401,12 ＠＠ { Lisp_Bignum *b; +#ifdef MC_ALLOC + b = alloc_lrecord_type (Lisp_Bignum, &lrecord_bignum); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (bignum, Lisp_Bignum, b); set_lheader_implementation (&b->lheader, &lrecord_bignum); +#endif /* not MC_ALLOC */ bignum_init (bignum_data (b)); bignum_set (bignum_data (b), bg); return wrap_bignum (b); ＠＠ -1247,16 +1415,22 ＠＠ /*** Ratio ***/ #ifdef HAVE_RATIO +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (ratio, Lisp_Ratio); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_ratio 250 +#endif /* not MC_ALLOC */ Lisp_Object make_ratio (long numerator, unsigned long denominator) { Lisp_Ratio *r; +#ifdef MC_ALLOC + r = alloc_lrecord_type (Lisp_Ratio, &lrecord_ratio); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (ratio, Lisp_Ratio, r); set_lheader_implementation (&r->lheader, &lrecord_ratio); +#endif /* not MC_ALLOC */ ratio_init (ratio_data (r)); ratio_set_long_ulong (ratio_data (r), numerator, denominator); ratio_canonicalize (ratio_data (r)); ＠＠ -1268,8 +1442,12 ＠＠ { Lisp_Ratio *r; +#ifdef MC_ALLOC + r = alloc_lrecord_type (Lisp_Ratio, &lrecord_ratio); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (ratio, Lisp_Ratio, r); set_lheader_implementation (&r->lheader, &lrecord_ratio); +#endif /* not MC_ALLOC */ ratio_init (ratio_data (r)); ratio_set_bignum_bignum (ratio_data (r), numerator, denominator); ratio_canonicalize (ratio_data (r)); ＠＠ -1281,8 +1459,12 ＠＠ { Lisp_Ratio *r; +#ifdef MC_ALLOC + r = alloc_lrecord_type (Lisp_Ratio, &lrecord_ratio); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (ratio, Lisp_Ratio, r); set_lheader_implementation (&r->lheader, &lrecord_ratio); +#endif /* not MC_ALLOC */ ratio_init (ratio_data (r)); ratio_set (ratio_data (r), rat); return wrap_ratio (r); ＠＠ -1291,8 +1473,10 ＠＠ /*** Bigfloat ***/ #ifdef HAVE_BIGFLOAT +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (bigfloat, Lisp_Bigfloat); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_bigfloat 250 +#endif /* not MC_ALLOC */ /* This function creates a bigfloat with the default precision if the PRECISION argument is zero. */ ＠＠ -1301,8 +1485,12 ＠＠ { Lisp_Bigfloat *f; +#ifdef MC_ALLOC + f = alloc_lrecord_type (Lisp_Bigfloat, &lrecord_bigfloat); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (bigfloat, Lisp_Bigfloat, f); set_lheader_implementation (&f->lheader, &lrecord_bigfloat); +#endif /* not MC_ALLOC */ if (precision == 0UL) bigfloat_init (bigfloat_data (f)); else ＠＠ -1317,8 +1505,12 ＠＠ { Lisp_Bigfloat *f; +#ifdef MC_ALLOC + f = alloc_lrecord_type (Lisp_Bigfloat, &lrecord_bigfloat); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (bigfloat, Lisp_Bigfloat, f); set_lheader_implementation (&f->lheader, &lrecord_bigfloat); +#endif /* not MC_ALLOC */ bigfloat_init_prec (bigfloat_data (f), bigfloat_get_prec (float_value)); bigfloat_set (bigfloat_data (f), float_value); return wrap_bigfloat (f); ＠＠ -1395,7 +1587,11 ＠＠ Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, contents, sizei); Lisp_Vector *p = +#ifdef MC_ALLOC + (Lisp_Vector *) alloc_lrecord (sizem, &lrecord_vector); +#else /* not MC_ALLOC */ (Lisp_Vector *) basic_alloc_lcrecord (sizem, &lrecord_vector); +#endif /* not MC_ALLOC */ p->size = sizei; return p; ＠＠ -1552,7 +1748,11 ＠＠ unsigned long, bits, num_longs); Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) +#ifdef MC_ALLOC + alloc_lrecord (sizem, &lrecord_bit_vector); +#else /* not MC_ALLOC */ basic_alloc_lcrecord (sizem, &lrecord_bit_vector); +#endif /* not MC_ALLOC */ bit_vector_length (p) = sizei; return p; ＠＠ -1628,16 +1828,22 ＠＠ /* Compiled-function allocation */ /************************************************************************/ +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (compiled_function, Lisp_Compiled_Function); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_compiled_function 1000 +#endif /* not MC_ALLOC */ static Lisp_Object make_compiled_function (void) { Lisp_Compiled_Function *f; +#ifdef MC_ALLOC + f = alloc_lrecord_type (Lisp_Compiled_Function, &lrecord_compiled_function); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (compiled_function, Lisp_Compiled_Function, f); set_lheader_implementation (&f->lheader, &lrecord_compiled_function); +#endif /* not MC_ALLOC */ f->stack_depth = 0; f->specpdl_depth = 0; ＠＠ -1769,8 +1975,10 ＠＠ /* Symbol allocation */ /************************************************************************/ +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (symbol, Lisp_Symbol); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_symbol 1000 +#endif /* not MC_ALLOC */ DEFUN ("make-symbol", Fmake_symbol, 1, 1, 0, /* Return a newly allocated uninterned symbol whose name is NAME. ＠＠ -1782,8 +1990,12 ＠＠ CHECK_STRING (name); +#ifdef MC_ALLOC + p = alloc_lrecord_type (Lisp_Symbol, &lrecord_symbol); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (symbol, Lisp_Symbol, p); set_lheader_implementation (&p->lheader, &lrecord_symbol); +#endif /* not MC_ALLOC */ p->name = name; p->plist = Qnil; p->value = Qunbound; ＠＠ -1797,16 +2009,22 ＠＠ /* Extent allocation */ /************************************************************************/ +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (extent, struct extent); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_extent 1000 +#endif /* not MC_ALLOC */ struct extent * allocate_extent (void) { struct extent *e; +#ifdef MC_ALLOC + e = alloc_lrecord_type (struct extent, &lrecord_extent); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (extent, struct extent, e); set_lheader_implementation (&e->lheader, &lrecord_extent); +#endif /* not MC_ALLOC */ extent_object (e) = Qnil; set_extent_start (e, -1); set_extent_end (e, -1); ＠＠ -1826,161 +2044,221 ＠＠ /* Event allocation */ /************************************************************************/ +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (event, Lisp_Event); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_event 1000 +#endif /* not MC_ALLOC */ Lisp_Object allocate_event (void) { Lisp_Event *e; +#ifdef MC_ALLOC + e = alloc_lrecord_type (Lisp_Event, &lrecord_event); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (event, Lisp_Event, e); set_lheader_implementation (&e->lheader, &lrecord_event); +#endif /* not MC_ALLOC */ return wrap_event (e); } #ifdef EVENT_DATA_AS_OBJECTS +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (key_data, Lisp_Key_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_key_data 1000 +#endif /* not MC_ALLOC */ Lisp_Object make_key_data (void) { Lisp_Key_Data *d; +#ifdef MC_ALLOC + d = alloc_lrecord_type (Lisp_Key_Data, &lrecord_key_data); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (key_data, Lisp_Key_Data, d); xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_key_data); +#endif /* not MC_ALLOC */ d->keysym = Qnil; return wrap_key_data (d); } +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (button_data, Lisp_Button_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_button_data 1000 +#endif /* not MC_ALLOC */ Lisp_Object make_button_data (void) { Lisp_Button_Data *d; +#ifdef MC_ALLOC + d = alloc_lrecord_type (Lisp_Button_Data, &lrecord_button_data); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (button_data, Lisp_Button_Data, d); xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_button_data); +#endif /* not MC_ALLOC */ return wrap_button_data (d); } +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (motion_data, Lisp_Motion_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_motion_data 1000 +#endif /* not MC_ALLOC */ Lisp_Object make_motion_data (void) { Lisp_Motion_Data *d; +#ifdef MC_ALLOC + d = alloc_lrecord_type (Lisp_Motion_Data, &lrecord_motion_data); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (motion_data, Lisp_Motion_Data, d); xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_motion_data); +#endif /* not MC_ALLOC */ return wrap_motion_data (d); } +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (process_data, Lisp_Process_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_process_data 1000 +#endif /* not MC_ALLOC */ Lisp_Object make_process_data (void) { Lisp_Process_Data *d; +#ifdef MC_ALLOC + d = alloc_lrecord_type (Lisp_Process_Data, &lrecord_process_data); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (process_data, Lisp_Process_Data, d); xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_process_data); d->process = Qnil; +#endif /* not MC_ALLOC */ return wrap_process_data (d); } +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (timeout_data, Lisp_Timeout_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_timeout_data 1000 +#endif /* not MC_ALLOC */ Lisp_Object make_timeout_data (void) { Lisp_Timeout_Data *d; +#ifdef MC_ALLOC + d = alloc_lrecord_type (Lisp_Timeout_Data, &lrecord_timeout_data); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (timeout_data, Lisp_Timeout_Data, d); xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_timeout_data); d->function = Qnil; d->object = Qnil; +#endif /* not MC_ALLOC */ return wrap_timeout_data (d); } +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (magic_data, Lisp_Magic_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_data 1000 +#endif /* not MC_ALLOC */ Lisp_Object make_magic_data (void) { Lisp_Magic_Data *d; +#ifdef MC_ALLOC + d = alloc_lrecord_type (Lisp_Magic_Data, &lrecord_magic_data); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (magic_data, Lisp_Magic_Data, d); xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_magic_data); +#endif /* not MC_ALLOC */ return wrap_magic_data (d); } +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (magic_eval_data, Lisp_Magic_Eval_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_eval_data 1000 +#endif /* not MC_ALLOC */ Lisp_Object make_magic_eval_data (void) { Lisp_Magic_Eval_Data *d; +#ifdef MC_ALLOC + d = alloc_lrecord_type (Lisp_Magic_Eval_Data, &lrecord_magic_eval_data); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (magic_eval_data, Lisp_Magic_Eval_Data, d); xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_magic_eval_data); d->object = Qnil; +#endif /* not MC_ALLOC */ return wrap_magic_eval_data (d); } +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (eval_data, Lisp_Eval_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_eval_data 1000 +#endif /* not MC_ALLOC */ Lisp_Object make_eval_data (void) { Lisp_Eval_Data *d; +#ifdef MC_ALLOC + d = alloc_lrecord_type (Lisp_Eval_Data, &lrecord_eval_data); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (eval_data, Lisp_Eval_Data, d); xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_eval_data); d->function = Qnil; d->object = Qnil; +#endif /* not MC_ALLOC */ return wrap_eval_data (d); } +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (misc_user_data, Lisp_Misc_User_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_misc_user_data 1000 +#endif /* not MC_ALLOC */ Lisp_Object make_misc_user_data (void) { Lisp_Misc_User_Data *d; +#ifdef MC_ALLOC + d = alloc_lrecord_type (Lisp_Misc_User_Data, &lrecord_misc_user_data); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (misc_user_data, Lisp_Misc_User_Data, d); xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_misc_user_data); d->function = Qnil; d->object = Qnil; +#endif /* not MC_ALLOC */ return wrap_misc_user_data (d); } ＠＠ -1991,8 +2269,10 ＠＠ /* Marker allocation */ /************************************************************************/ +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (marker, Lisp_Marker); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_marker 1000 +#endif /* not MC_ALLOC */ DEFUN ("make-marker", Fmake_marker, 0, 0, 0, /* Return a new marker which does not point at any place. ＠＠ -2001,8 +2281,12 ＠＠ { Lisp_Marker *p; +#ifdef MC_ALLOC + p = alloc_lrecord_type (Lisp_Marker, &lrecord_marker); +#else /* not MC_ALLOC */ ALLOCATE_FIXED_TYPE (marker, Lisp_Marker, p); set_lheader_implementation (&p->lheader, &lrecord_marker); +#endif /* not MC_ALLOC */ p->buffer = 0; p->membpos = 0; marker_next (p) = 0; ＠＠ -2016,8 +2300,12 ＠＠ { Lisp_Marker *p; +#ifdef MC_ALLOC + p = noseeum_alloc_lrecord_type (Lisp_Marker, &lrecord_marker); +#else /* not MC_ALLOC */ NOSEEUM_ALLOCATE_FIXED_TYPE (marker, Lisp_Marker, p); set_lheader_implementation (&p->lheader, &lrecord_marker); +#endif /* not MC_ALLOC */ p->buffer = 0; p->membpos = 0; marker_next (p) = 0; ＠＠ -2044,10 +2332,12 ＠＠ This new method makes things somewhat bigger, but it is MUCH safer. */ +#ifndef MC_ALLOC DECLARE_FIXED_TYPE_ALLOC (string, Lisp_String); /* strings are used and freed quite often */ /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 10000 */ #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 1000 +#endif /* not MC_ALLOC */ static Lisp_Object mark_string (Lisp_Object obj) ＠＠ -2119,11 +2409,13 ＠＠ return *string_plist_ptr (string); } +#ifndef MC_ALLOC /* No `finalize', or `hash' methods. internal_hash() already knows how to hash strings and finalization is done with the ADDITIONAL_FREE_string macro, which is the standard way to do finalization when using SWEEP_FIXED_TYPE_BLOCK(). */ + DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, 1, /*dumpable-flag*/ mark_string, print_string, ＠＠ -2134,6 +2426,8 ＠＠ string_remprop, string_plist, Lisp_String); +#endif /* not MC_ALLOC */ + /* String blocks contain this many useful bytes. */ #define STRING_CHARS_BLOCK_SIZE \ ((Bytecount) (8192 - MALLOC_OVERHEAD - \ ＠＠ -2166,6 +2460,33 ＠＠ #define STRING_CHARS_FREE_P(ptr) ((ptr)->string == NULL) #define MARK_STRING_CHARS_AS_FREE(ptr) ((void) ((ptr)->string = NULL)) +#ifdef MC_ALLOC +static void +finalize_string (void *header, int for_disksave) +{ + if (!for_disksave) + { + Lisp_String *s = (Lisp_String *) header; + Bytecount size = s->size_; + if (BIG_STRING_SIZE_P (size)) + xfree (s->data_, Ibyte *); + } +} + +DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, + 1, /*dumpable-flag*/ + mark_string, print_string, + finalize_string, + string_equal, 0, + string_description, + string_getprop, + string_putprop, + string_remprop, + string_plist, + Lisp_String); + +#endif /* MC_ALLOC */ + struct string_chars { Lisp_String *string; ＠＠ -2264,15 +2585,19 ＠＠ assert (length >= 0 && fullsize > 0); +#ifdef MC_ALLOC + s = alloc_lrecord_type (Lisp_String, &lrecord_string); +#else /* not MC_ALLOC */ /* Allocate the string header */ ALLOCATE_FIXED_TYPE (string, Lisp_String, s); xzero (*s); set_lheader_implementation (&s->u.lheader, &lrecord_string); - +#endif /* not MC_ALLOC */ + set_lispstringp_data (s, BIG_STRING_FULLSIZE_P (fullsize) - ? allocate_big_string_chars (length + 1) - : allocate_string_chars_struct (wrap_string (s), - fullsize)->chars); + ? allocate_big_string_chars (length + 1) + : allocate_string_chars_struct (wrap_string (s), + fullsize)->chars); set_lispstringp_length (s, length); s->plist = Qnil; ＠＠ -2298,7 +2623,6 ＠＠ #ifdef VERIFY_STRING_CHARS_INTEGRITY verify_string_chars_integrity (); #endif - #ifdef ERROR_CHECK_TEXT if (pos >= 0) { ＠＠ -2498,6 +2822,16 ＠＠ EMACS_INT i; Ibyte *ptr = XSTRING_DATA (val); +#ifdef MC_ALLOC + /* Need this for the new allocator: strings are using the uid + field for ascii_begin. The uid field is set for debugging, + but the string code assumes here that ascii_begin is always + zero, when not touched. This assumption is not true with + the new allocator, so ascii_begin has to be set to zero + here. */ + XSET_STRING_ASCII_BEGIN (val, 0); +#endif /* not MC_ALLOC */ + for (i = XINT (length); i; i--) { Ibyte *init_ptr = init_str; ＠＠ -2634,10 +2968,17 ＠＠ bytecount_to_charcount (contents, length); /* Just for the assertions */ #endif +#ifdef MC_ALLOC + s = alloc_lrecord_type (Lisp_String, &lrecord_string); + mcpro (wrap_pointer_1 (s)); /* otherwise nocopy_strings get + collected and static data is tried to + be freed. */ +#else /* not MC_ALLOC */ /* Allocate the string header */ ALLOCATE_FIXED_TYPE (string, Lisp_String, s); set_lheader_implementation (&s->u.lheader, &lrecord_string); SET_C_READONLY_RECORD_HEADER (&s->u.lheader); +#endif /* not MC_ALLOC */ s->plist = Qnil; set_lispstringp_data (s, (Ibyte *) contents); set_lispstringp_length (s, length); ＠＠ -2649,6 +2990,7 ＠＠ } +#ifndef MC_ALLOC /************************************************************************/ /* lcrecord lists */ /************************************************************************/ ＠＠ -2856,6 +3198,7 ＠＠ free_managed_lcrecord (all_lcrecord_lists[type], rec); } +#endif /* not MC_ALLOC */ DEFUN ("purecopy", Fpurecopy, 1, 1, 0, /* ＠＠ -3030,7 +3373,91 ＠＠ #endif /* not DEBUG_XEMACS */ + + + + +#ifdef MC_ALLOC +static const struct memory_description mcpro_description_1[] = { + { XD_END } +}; + +static const struct sized_memory_description mcpro_description = { + sizeof (Lisp_Object *), + mcpro_description_1 +}; + +static const struct memory_description mcpros_description_1[] = { + XD_DYNARR_DESC (Lisp_Object_dynarr, &mcpro_description), + { XD_END } +}; + +static const struct sized_memory_description mcpros_description = { + sizeof (Lisp_Object_dynarr), + mcpros_description_1 +}; + +#ifdef DEBUG_XEMACS + +static const struct memory_description mcpro_one_name_description_1[] = { + { XD_ASCII_STRING, 0 }, + { XD_END } +}; + +static const struct sized_memory_description mcpro_one_name_description = { + sizeof (char *), + mcpro_one_name_description_1 +}; + +static const struct memory_description mcpro_names_description_1[] = { + XD_DYNARR_DESC (char_ptr_dynarr, &mcpro_one_name_description), + { XD_END } +}; + +extern const struct sized_memory_description mcpro_names_description; + +const struct sized_memory_description mcpro_names_description = { + sizeof (char_ptr_dynarr), + mcpro_names_description_1 +}; + +/* Help debug crashes gc-marking a mcpro'ed object. */ + +Lisp_Object_dynarr *mcpros; +char_ptr_dynarr *mcpro_names; + +/* Mark the Lisp_Object at non-heap VARADDRESS as a root object for + garbage collection, and for dumping. */ +void +mcpro_1 (Lisp_Object varaddress, char *varname) +{ + Dynarr_add (mcpros, varaddress); + Dynarr_add (mcpro_names, varname); +} + +#else /* not DEBUG_XEMACS */ + +Lisp_Object_dynarr *mcpros; + +/* Mark the Lisp_Object at non-heap VARADDRESS as a root object for + garbage collection, and for dumping. */ +void +mcpro (Lisp_Object varaddress) +{ + Dynarr_add (mcpros, varaddress); +} + +#endif /* not DEBUG_XEMACS */ +#endif /* MC_ALLOC */ + #ifdef ERROR_CHECK_GC +#ifdef MC_ALLOC +#define GC_CHECK_LHEADER_INVARIANTS(lheader) do { \ + struct lrecord_header * GCLI_lh = (lheader); \ + assert (GCLI_lh != 0); \ + assert (GCLI_lh->type < (unsigned int) lrecord_type_count); \ +} while (0) +#else /* not MC_ALLOC */ #define GC_CHECK_LHEADER_INVARIANTS(lheader) do { \ struct lrecord_header * GCLI_lh = (lheader); \ assert (GCLI_lh != 0); \ ＠＠ -3039,6 +3466,7 ＠＠ (MARKED_RECORD_HEADER_P (GCLI_lh) && \ LISP_READONLY_RECORD_HEADER_P (GCLI_lh))); \ } while (0) +#endif /* not MC_ALLOC */ #else #define GC_CHECK_LHEADER_INVARIANTS(lheader) #endif ＠＠ -3291,9 +3719,15 ＠＠ #endif /* defined (USE_KKCC) || defined (PDUMP) */ +#ifdef MC_ALLOC +#define GC_CHECK_NOT_FREE(lheader) \ + gc_checking_assert (! LRECORD_FREE_P (lheader)); +#else /* MC_ALLOC */ #define GC_CHECK_NOT_FREE(lheader) \ + gc_checking_assert (! LRECORD_FREE_P (lheader)); \ gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p || \ ! ((struct lcrecord_header *) lheader)->free) +#endif /* MC_ALLOC */ #ifdef USE_KKCC /* The following functions implement the new mark algorithm. ＠＠ -3339,7 +3773,11 ＠＠ { Lisp_Object obj = wrap_pointer_1 (kkcc_bt[i].obj); stderr_out (" [%d]", i); +#ifdef MC_ALLOC + if ((XRECORD_LHEADER (obj)->type >= lrecord_type_last_built_in_type) +#else /* not MC_ALLOC */ if ((XRECORD_LHEADER (obj)->type >= lrecord_type_free) +#endif /* not MC_ALLOC */ || (!LRECORDP (obj)) || (!XRECORD_LHEADER_IMPLEMENTATION (obj))) { ＠＠ -3630,6 +4068,9 ＠＠ kkcc_bt_push (data, desc, stack_entry->level, stack_entry->pos); + gc_checking_assert (data); + gc_checking_assert (desc); + for (pos = 0; desc[pos].type != XD_END; pos++) { const struct memory_description *desc1 = &desc[pos]; ＠＠ -3666,10 +4107,14 ＠＠ though. */ if (EQ (*stored_obj, Qnull_pointer)) break; +#ifdef MC_ALLOC + mark_object_maybe_checking_free (*stored_obj, 0, level, pos); +#else /* not MC_ALLOC */ mark_object_maybe_checking_free (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT, level, pos); break; +#endif /* not MC_ALLOC */ } case XD_LISP_OBJECT_ARRAY: { ＠＠ -3684,9 +4129,13 ＠＠ if (EQ (*stored_obj, Qnull_pointer)) break; +#ifdef MC_ALLOC + mark_object_maybe_checking_free (*stored_obj, 0, level, pos); +#else /* not MC_ALLOC */ mark_object_maybe_checking_free (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT, level, pos); +#endif /* not MC_ALLOC */ } break; } ＠＠ -3783,6 +4232,7 ＠＠ } +#ifndef MC_ALLOC static int gc_count_num_short_string_in_use; static Bytecount gc_count_string_total_size; static Bytecount gc_count_short_string_total_size; ＠＠ -3828,8 +4278,10 ＠＠ } } } +#endif /* not MC_ALLOC */ +#ifndef MC_ALLOC /* Free all unmarked records */ static void sweep_lcrecords_1 (struct lcrecord_header **prev, int *used) ＠＠ -4025,9 +4477,10 ＠＠ #define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type) \ SWEEP_FIXED_TYPE_BLOCK_1 (typename, obj_type, lheader) - - +#endif /* not MC_ALLOC */ + +#ifndef MC_ALLOC static void sweep_conses (void) { ＠＠ -4036,14 +4489,20 ＠＠ SWEEP_FIXED_TYPE_BLOCK (cons, Lisp_Cons); } +#endif /* not MC_ALLOC */ /* Explicitly free a cons cell. */ void free_cons (Lisp_Object cons) { +#ifndef MC_ALLOC /* to avoid compiler warning */ Lisp_Cons *ptr = XCONS (cons); +#endif /* MC_ALLOC */ #ifdef ERROR_CHECK_GC +#ifdef MC_ALLOC + Lisp_Cons *ptr = XCONS (cons); +#endif /* MC_ALLOC */ /* If the CAR is not an int, then it will be a pointer, which will always be four-byte aligned. If this cons cell has already been placed on the free list, however, its car will probably contain ＠＠ -4058,7 +4517,11 ＠＠ ASSERT_VALID_POINTER (XPNTR (cons_car (ptr))); #endif /* ERROR_CHECK_GC */ +#ifdef MC_ALLOC + free_lrecord (cons); +#else /* not MC_ALLOC */ FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, Lisp_Cons, ptr); +#endif /* not MC_ALLOC */ } /* explicitly free a list. You **must make sure** that you have ＠＠ -4096,6 +4559,7 ＠＠ } } +#ifndef MC_ALLOC static void sweep_compiled_functions (void) { ＠＠ -4174,9 +4638,11 ＠＠ SWEEP_FIXED_TYPE_BLOCK (event, Lisp_Event); } +#endif /* not MC_ALLOC */ #ifdef EVENT_DATA_AS_OBJECTS +#ifndef MC_ALLOC static void sweep_key_data (void) { ＠＠ -4185,13 +4651,19 ＠＠ SWEEP_FIXED_TYPE_BLOCK (key_data, Lisp_Key_Data); } +#endif /* not MC_ALLOC */ void free_key_data (Lisp_Object ptr) { +#ifdef MC_ALLOC + free_lrecord (ptr); +#else /* not MC_ALLOC */ FREE_FIXED_TYPE_WHEN_NOT_IN_GC (key_data, Lisp_Key_Data, XKEY_DATA (ptr)); +#endif /* not MC_ALLOC */ } +#ifndef MC_ALLOC static void sweep_button_data (void) { ＠＠ -4200,13 +4672,19 ＠＠ SWEEP_FIXED_TYPE_BLOCK (button_data, Lisp_Button_Data); } +#endif /* not MC_ALLOC */ void free_button_data (Lisp_Object ptr) { +#ifdef MC_ALLOC + free_lrecord (ptr); +#else /* not MC_ALLOC */ FREE_FIXED_TYPE_WHEN_NOT_IN_GC (button_data, Lisp_Button_Data, XBUTTON_DATA (ptr)); +#endif /* not MC_ALLOC */ } +#ifndef MC_ALLOC static void sweep_motion_data (void) { ＠＠ -4215,13 +4693,19 ＠＠ SWEEP_FIXED_TYPE_BLOCK (motion_data, Lisp_Motion_Data); } +#endif /* not MC_ALLOC */ void free_motion_data (Lisp_Object ptr) { +#ifdef MC_ALLOC + free_lrecord (ptr); +#else /* not MC_ALLOC */ FREE_FIXED_TYPE_WHEN_NOT_IN_GC (motion_data, Lisp_Motion_Data, XMOTION_DATA (ptr)); +#endif /* not MC_ALLOC */ } +#ifndef MC_ALLOC static void sweep_process_data (void) { ＠＠ -4230,13 +4714,19 ＠＠ SWEEP_FIXED_TYPE_BLOCK (process_data, Lisp_Process_Data); } +#endif /* not MC_ALLOC */ void free_process_data (Lisp_Object ptr) { +#ifdef MC_ALLOC + free_lrecord (ptr); +#else /* not MC_ALLOC */ FREE_FIXED_TYPE_WHEN_NOT_IN_GC (process_data, Lisp_Process_Data, XPROCESS_DATA (ptr)); +#endif /* not MC_ALLOC */ } +#ifndef MC_ALLOC static void sweep_timeout_data (void) { ＠＠ -4245,13 +4735,19 ＠＠ SWEEP_FIXED_TYPE_BLOCK (timeout_data, Lisp_Timeout_Data); } +#endif /* not MC_ALLOC */ void free_timeout_data (Lisp_Object ptr) { +#ifdef MC_ALLOC + free_lrecord (ptr); +#else /* not MC_ALLOC */ FREE_FIXED_TYPE_WHEN_NOT_IN_GC (timeout_data, Lisp_Timeout_Data, XTIMEOUT_DATA (ptr)); +#endif /* not MC_ALLOC */ } +#ifndef MC_ALLOC static void sweep_magic_data (void) { ＠＠ -4260,13 +4756,19 ＠＠ SWEEP_FIXED_TYPE_BLOCK (magic_data, Lisp_Magic_Data); } +#endif /* not MC_ALLOC */ void free_magic_data (Lisp_Object ptr) { +#ifdef MC_ALLOC + free_lrecord (ptr); +#else /* not MC_ALLOC */ FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_data, Lisp_Magic_Data, XMAGIC_DATA (ptr)); +#endif /* not MC_ALLOC */ } +#ifndef MC_ALLOC static void sweep_magic_eval_data (void) { ＠＠ -4275,13 +4777,19 ＠＠ SWEEP_FIXED_TYPE_BLOCK (magic_eval_data, Lisp_Magic_Eval_Data); } +#endif /* not MC_ALLOC */ void free_magic_eval_data (Lisp_Object ptr) { +#ifdef MC_ALLOC + free_lrecord (ptr); +#else /* not MC_ALLOC */ FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_eval_data, Lisp_Magic_Eval_Data, XMAGIC_EVAL_DATA (ptr)); +#endif /* not MC_ALLOC */ } +#ifndef MC_ALLOC static void sweep_eval_data (void) { ＠＠ -4290,13 +4798,19 ＠＠ SWEEP_FIXED_TYPE_BLOCK (eval_data, Lisp_Eval_Data); } +#endif /* not MC_ALLOC */ void free_eval_data (Lisp_Object ptr) { +#ifdef MC_ALLOC + free_lrecord (ptr); +#else /* not MC_ALLOC */ FREE_FIXED_TYPE_WHEN_NOT_IN_GC (eval_data, Lisp_Eval_Data, XEVAL_DATA (ptr)); +#endif /* not MC_ALLOC */ } +#ifndef MC_ALLOC static void sweep_misc_user_data (void) { ＠＠ -4305,15 +4819,21 ＠＠ SWEEP_FIXED_TYPE_BLOCK (misc_user_data, Lisp_Misc_User_Data); } +#endif /* not MC_ALLOC */ void free_misc_user_data (Lisp_Object ptr) { +#ifdef MC_ALLOC + free_lrecord (ptr); +#else /* not MC_ALLOC */ FREE_FIXED_TYPE_WHEN_NOT_IN_GC (misc_user_data, Lisp_Misc_User_Data, XMISC_USER_DATA (ptr)); +#endif /* not MC_ALLOC */ } #endif /* EVENT_DATA_AS_OBJECTS */ +#ifndef MC_ALLOC static void sweep_markers (void) { ＠＠ -4326,12 +4846,17 ＠＠ SWEEP_FIXED_TYPE_BLOCK (marker, Lisp_Marker); } +#endif /* not MC_ALLOC */ /* Explicitly free a marker. */ void free_marker (Lisp_Object ptr) { +#ifdef MC_ALLOC + free_lrecord (ptr); +#else /* not MC_ALLOC */ FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, XMARKER (ptr)); +#endif /* not MC_ALLOC */ } ＠＠ -4374,7 +4899,7 ＠＠ fullsize = STRING_FULLSIZE (size); assert (!BIG_STRING_FULLSIZE_P (fullsize)); - assert (string->data_ == s_chars->chars); + assert (XSTRING_DATA (string) == s_chars->chars); pos += fullsize; } assert (pos == sb->pos); ＠＠ -4482,6 +5007,7 ＠＠ } } +#ifndef MC_ALLOC #if 1 /* Hack to debug missing purecopy's */ static int debug_string_purity; ＠＠ -4504,8 +5030,9 ＠＠ stderr_out ("\"\n"); } #endif /* 1 */ +#endif /* not MC_ALLOC */ - +#ifndef MC_ALLOC static void sweep_strings (void) { ＠＠ -4538,7 +5065,7 ＠＠ gc_count_string_total_size = num_bytes; gc_count_short_string_total_size = num_small_bytes; } - +#endif /* not MC_ALLOC */ /* I hate duplicating all this crap! */ int ＠＠ -4563,6 +5090,11 ＠＠ static void gc_sweep (void) { +#ifdef MC_ALLOC + compact_string_chars (); + mc_finalize (); + mc_sweep (); +#else /* not MC_ALLOC */ /* Free all unmarked records. Do this at the very beginning, before anything else, so that the finalize methods can safely examine items in the objects. sweep_lcrecords_1() makes ＠＠ -4637,10 +5169,13 ＠＠ sweep_eval_data (); sweep_misc_user_data (); #endif /* EVENT_DATA_AS_OBJECTS */ +#endif /* not MC_ALLOC */ +#ifndef MC_ALLOC #ifdef PDUMP pdump_objects_unmark (); #endif +#endif /* not MC_ALLOC */ } /* Clearing for disksave. */ ＠＠ -4930,6 +5465,15 ＠＠ mark_object (**p++); } +#ifdef MC_ALLOC + { /* mcpro () */ + Lisp_Object *p = Dynarr_begin (mcpros); + Elemcount count; + for (count = Dynarr_length (mcpros); count; count--) + mark_object (*p++); + } +#endif /* MC_ALLOC */ + { /* GCPRO() */ struct gcpro *tail; int i; ＠＠ -5073,10 +5617,12 ＠＠ /* now stop inhibiting GC */ unbind_to (speccount); +#ifndef MC_ALLOC if (!breathing_space) { breathing_space = malloc (4096 - MALLOC_OVERHEAD); } +#endif /* not MC_ALLOC */ UNGCPRO; ＠＠ -5088,6 +5634,93 ＠＠ return; } +#ifdef MC_ALLOC +#ifdef MC_ALLOC_TYPE_STATS +static Lisp_Object +gc_plist_hack (const Ascbyte *name, int value, Lisp_Object tail) +{ + /* C doesn't have local functions (or closures, or GC, or readable syntax, + or portable numeric datatypes, or bit-vectors, or characters, or + arrays, or exceptions, or ...) */ + return cons3 (intern (name), make_int (value), tail); +} +#endif /* MC_ALLOC_TYPE_STATS */ + +DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /* +Reclaim storage for Lisp objects no longer needed. +Return info on amount of space in use: + ((USED-CONSES . STORAGE-CONSES) (USED-SYMS . STORAGE-SYMS) + (USED-MARKERS . STORAGE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS + PLIST) + where `PLIST' is a list of alternating keyword/value pairs providing + more detailed information. +Garbage collection happens automatically if you cons more than +`gc-cons-threshold' bytes of Lisp data since previous garbage collection. +*/ + ()) +{ +#ifdef MC_ALLOC_TYPE_STATS + Lisp_Object pl = Qnil; + int i; +#endif /* not MC_ALLOC_TYPE_STATS */ + + garbage_collect_1 (); + +#ifdef MC_ALLOC_TYPE_STATS + for (i = 0; i < (countof (lrecord_implementations_table) + + MODULE_DEFINABLE_TYPE_COUNT); i++) + { + if (lrecord_stats[i].instances_in_use != 0) + { + char buf [255]; + const char *name = lrecord_implementations_table[i]->name; + int len = strlen (name); + + if (lrecord_stats[i].bytes_in_use_including_overhead != + lrecord_stats[i].bytes_in_use) + { + sprintf (buf, "%s-storage-including-overhead", name); + pl = gc_plist_hack (buf, + lrecord_stats[i] + .bytes_in_use_including_overhead, + pl); + } + + sprintf (buf, "%s-storage", name); + pl = gc_plist_hack (buf, + lrecord_stats[i].bytes_in_use, + pl); + + if (name[len-1] == 's') + sprintf (buf, "%ses-used", name); + else + sprintf (buf, "%ss-used", name); + pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl); + } + } + + /* The things we do for backwards-compatibility */ + return + list6 + (Fcons (make_int (lrecord_stats[lrecord_type_cons].instances_in_use), + make_int (lrecord_stats[lrecord_type_cons] + .bytes_in_use_including_overhead)), + Fcons (make_int (lrecord_stats[lrecord_type_symbol].instances_in_use), + make_int (lrecord_stats[lrecord_type_symbol] + .bytes_in_use_including_overhead)), + Fcons (make_int (lrecord_stats[lrecord_type_marker].instances_in_use), + make_int (lrecord_stats[lrecord_type_marker] + .bytes_in_use_including_overhead)), + make_int (lrecord_stats[lrecord_type_string] + .bytes_in_use_including_overhead), + make_int (lrecord_stats[lrecord_type_vector] + .bytes_in_use_including_overhead), + pl); +#else /* not MC_ALLOC_TYPE_STATS */ + return Qnil; +#endif /* not MC_ALLOC_TYPE_STATS */ +} +#else /* not MC_ALLOC */ /* Debugging aids. */ static Lisp_Object ＠＠ -5230,6 +5863,7 ＠＠ pl); } #undef HACK_O_MATIC +#endif /* not MC_ALLOC */ DEFUN ("consing-since-gc", Fconsing_since_gc, 0, 0, "", /* Return the number of bytes consed since the last garbage collection. ＠＠ -5423,6 +6057,7 ＠＠ return claimed_size; } +#ifndef MC_ALLOC Bytecount fixed_type_block_overhead (Bytecount size) { ＠＠ -5438,7 +6073,7 ＠＠ overhead += sizeof (void *) + per_block - storage_size; return overhead; } - +#endif /* not MC_ALLOC */ #endif /* MEMORY_USAGE_STATS */ ＠＠ -5457,9 +6092,13 ＠＠ #endif gc_generation_number[0] = 0; +#ifndef MC_ALLOC breathing_space = 0; +#endif /* not MC_ALLOC */ Vgc_message = Qzero; +#ifndef MC_ALLOC all_lcrecords = 0; +#endif /* not MC_ALLOC */ ignore_malloc_warnings = 1; #ifdef DOUG_LEA_MALLOC mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */ ＠＠ -5468,6 +6107,8 ＠＠ mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */ #endif #endif + init_string_chars_alloc (); +#ifndef MC_ALLOC init_string_alloc (); init_string_chars_alloc (); init_cons_alloc (); ＠＠ -5497,6 +6138,7 ＠＠ init_eval_data_alloc (); init_misc_user_data_alloc (); #endif /* EVENT_DATA_AS_OBJECTS */ +#endif /* not MC_ALLOC */ ignore_malloc_warnings = 0; ＠＠ -5511,6 +6153,17 ＠＠ Dynarr_resize (staticpro_nodump_names, 100); /* ditto */ #endif +#ifdef MC_ALLOC + mcpros = Dynarr_new2 (Lisp_Object_dynarr, Lisp_Object); + Dynarr_resize (mcpros, 1410); /* merely a small optimization */ + dump_add_root_block_ptr (&mcpros, &mcpros_description); +#ifdef DEBUG_XEMACS + mcpro_names = Dynarr_new2 (char_ptr_dynarr, char *); + Dynarr_resize (mcpro_names, 1410); /* merely a small optimization */ + dump_add_root_block_ptr (&mcpro_names, &mcpro_names_description); +#endif +#endif /* MC_ALLOC */ + consing_since_gc = 0; need_to_garbage_collect = always_gc; need_to_check_c_alloca = 0; ＠＠ -5526,7 +6179,9 ＠＠ memory usage on Windows; not verified on other systems */ lrecord_uid_counter = 259; +#ifndef MC_ALLOC debug_string_purity = 0; +#endif /* not MC_ALLOC */ gc_currently_forbidden = 0; gc_hooks_inhibited = 0; ＠＠ -5545,6 +6200,7 ＠＠ #endif /* ERROR_CHECK_TYPES */ } +#ifndef MC_ALLOC static void init_lcrecord_lists (void) { ＠＠ -5556,6 +6212,7 ＠＠ staticpro_nodump (&all_lcrecord_lists[i]); } } +#endif /* not MC_ALLOC */ void init_alloc_early (void) ＠＠ -5576,7 +6233,9 ＠＠ reinit_alloc_early (void) { common_init_alloc_early (); +#ifndef MC_ALLOC init_lcrecord_lists (); +#endif /* not MC_ALLOC */ } void ＠＠ -5593,8 +6252,10 ＠＠ INIT_LRECORD_IMPLEMENTATION (cons); INIT_LRECORD_IMPLEMENTATION (vector); INIT_LRECORD_IMPLEMENTATION (string); +#ifndef MC_ALLOC INIT_LRECORD_IMPLEMENTATION (lcrecord_list); INIT_LRECORD_IMPLEMENTATION (free); +#endif /* not MC_ALLOC */ staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *); Dynarr_resize (staticpros, 1410); /* merely a small optimization */ ＠＠ -5605,7 +6266,20 ＠＠ dump_add_root_block_ptr (&staticpro_names, &staticpro_names_description); #endif +#ifdef MC_ALLOC + mcpros = Dynarr_new2 (Lisp_Object_dynarr, Lisp_Object); + Dynarr_resize (mcpros, 1410); /* merely a small optimization */ + dump_add_root_block_ptr (&mcpros, &mcpros_description); +#ifdef DEBUG_XEMACS + mcpro_names = Dynarr_new2 (char_ptr_dynarr, char *); + Dynarr_resize (mcpro_names, 1410); /* merely a small optimization */ + dump_add_root_block_ptr (&mcpro_names, &mcpro_names_description); +#endif +#endif /* MC_ALLOC */ + +#ifndef MC_ALLOC init_lcrecord_lists (); +#endif /* not MC_ALLOC */ } void diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/buffer.c mc-xemacs-21.5/src/buffer.c --- xemacs-21.5/src/buffer.c 2005-03-03 00:40:39.000000000 +0100 +++ mc-xemacs-21.5/src/buffer.c 2005-03-19 00:52:19.000000000 +0100 ＠＠ -587,9 +587,15 ＠＠ static struct buffer * allocate_buffer (void) { +#ifdef MC_ALLOC + struct buffer *b = alloc_lrecord_type (struct buffer, &lrecord_buffer); + + copy_lrecord (b, XBUFFER (Vbuffer_defaults)); +#else /* not MC_ALLOC */ struct buffer *b = alloc_lcrecord_type (struct buffer, &lrecord_buffer); copy_lcrecord (b, XBUFFER (Vbuffer_defaults)); +#endif /* not MC_ALLOC */ return b; } ＠＠ -1757,7 +1763,11 ＠＠ struct overhead_stats *ovstats) { xzero (*stats); +#ifdef MC_ALLOC + stats->other += mc_alloced_storage_size (sizeof (*b), ovstats); +#else /* not MC_ALLOC */ stats->other += malloced_storage_size (b, sizeof (*b), ovstats); +#endif /* not MC_ALLOC */ stats->text += compute_buffer_text_usage (b, ovstats); stats->markers += compute_buffer_marker_usage (b, ovstats); stats->extents += compute_buffer_extent_usage (b, ovstats); ＠＠ -2113,38 +2123,67 ＠＠ /* The docstrings for DEFVAR_* are recorded externally by make-docfile. */ +#ifdef MC_ALLOC +#define DEFVAR_BUFFER_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);*/ \ + \ + I_hate_C->magic.value = &(buffer_local_flags.field_name); \ + I_hate_C->magic.type = forward_type; \ + I_hate_C->magicfun = magic_fun; \ + \ + MARK_LRECORD_AS_LISP_READONLY (I_hate_C); \ + \ + { \ + int offset = ((char *)symbol_value_forward_forward (I_hate_C) - \ + (char *)&buffer_local_flags); \ + defvar_magic (lname, I_hate_C); \ + \ + *((Lisp_Object *)(offset + (char *)XBUFFER (Vbuffer_local_symbols))) \ + = intern (lname); \ + } \ +} while (0) + +#else /* not MC_ALLOC */ /* Renamed from DEFVAR_PER_BUFFER because FSFmacs D_P_B takes a bogus extra arg, which confuses an otherwise identical make-docfile.c */ -#define DEFVAR_BUFFER_LOCAL_1(lname, field_name, forward_type, magicfun) do { \ - static const struct symbol_value_forward I_hate_C = \ - { /* struct symbol_value_forward */ \ - { /* struct symbol_value_magic */ \ - { /* struct lcrecord_header */ \ - { /* struct lrecord_header */ \ - lrecord_type_symbol_value_forward, /* lrecord_type_index */ \ - 1, /* mark bit */ \ - 1, /* c_readonly bit */ \ - 1 /* lisp_readonly bit */ \ - }, \ - 0, /* next */ \ - 0, /* uid */ \ - 0 /* free */ \ - }, \ - &(buffer_local_flags.field_name), \ - forward_type \ - }, \ - magicfun \ - }; \ - \ - { \ - int offset = ((char *)symbol_value_forward_forward (&I_hate_C) - \ - (char *)&buffer_local_flags); \ - defvar_magic (lname, &I_hate_C); \ - \ - *((Lisp_Object *)(offset + (char *)XBUFFER (Vbuffer_local_symbols))) \ - = intern (lname); \ - } \ +#define DEFVAR_BUFFER_LOCAL_1(lname, field_name, forward_type, magicfun) \ +do { \ + static const struct symbol_value_forward I_hate_C = \ + { /* struct symbol_value_forward */ \ + { /* struct symbol_value_magic */ \ + { /* struct lcrecord_header */ \ + { /* struct lrecord_header */ \ + lrecord_type_symbol_value_forward, /* lrecord_type_index */ \ + 1, /* mark bit */ \ + 1, /* c_readonly bit */ \ + 1 /* lisp_readonly bit */ \ + }, \ + 0, /* next */ \ + 0, /* uid */ \ + 0 /* free */ \ + }, \ + &(buffer_local_flags.field_name), \ + forward_type \ + }, \ + magicfun \ + }; \ + \ + { \ + int offset = ((char *)symbol_value_forward_forward (&I_hate_C) - \ + (char *)&buffer_local_flags); \ + defvar_magic (lname, &I_hate_C); \ + \ + *((Lisp_Object *)(offset + (char *)XBUFFER (Vbuffer_local_symbols))) \ + = intern (lname); \ + } \ } while (0) +#endif /* not MC_ALLOC */ + #define DEFVAR_BUFFER_LOCAL_MAGIC(lname, field_name, magicfun) \ DEFVAR_BUFFER_LOCAL_1 (lname, field_name, \ SYMVAL_CURRENT_BUFFER_FORWARD, magicfun) ＠＠ -2165,7 +2204,11 ＠＠ static void nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap) { +#ifdef MC_ALLOC + zero_lrecord (b); +#else /* not MC_ALLOC */ zero_lcrecord (b); +#endif /* not MC_ALLOC */ b->extent_info = Qnil; b->indirect_children = Qnil; ＠＠ -2180,8 +2223,13 ＠＠ { /* Make sure all markable slots in buffer_defaults are initialized reasonably, so mark_buffer won't choke. */ +#ifdef MC_ALLOC + struct buffer *defs = alloc_lrecord_type (struct buffer, &lrecord_buffer); + struct buffer *syms = alloc_lrecord_type (struct buffer, &lrecord_buffer); +#else /* not MC_ALLOC */ struct buffer *defs = alloc_lcrecord_type (struct buffer, &lrecord_buffer); struct buffer *syms = alloc_lcrecord_type (struct buffer, &lrecord_buffer); +#endif /* not MC_ALLOC */ staticpro_nodump (&Vbuffer_defaults); staticpro_nodump (&Vbuffer_local_symbols); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/buffer.h mc-xemacs-21.5/src/buffer.h --- xemacs-21.5/src/buffer.h 2005-03-03 00:40:39.000000000 +0100 +++ mc-xemacs-21.5/src/buffer.h 2005-02-01 22:58:28.000000000 +0100 ＠＠ -140,7 +140,11 ＠＠ struct buffer { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ /* This structure holds the coordinates of the buffer contents in ordinary buffers. In indirect buffers, this is not used. */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/bytecode.c mc-xemacs-21.5/src/bytecode.c --- xemacs-21.5/src/bytecode.c 2005-03-03 00:40:40.000000000 +0100 +++ mc-xemacs-21.5/src/bytecode.c 2005-02-03 22:02:37.000000000 +0100 ＠＠ -2191,6 +2191,29 ＠＠ { XD_END } }; +#ifdef MC_ALLOC +static void +finalize_compiled_function (void *header, int for_disksave) +{ + if (!for_disksave) + { + struct Lisp_Compiled_Function *cf = + (struct Lisp_Compiled_Function *) header; + if (cf->args_in_array) + xfree (cf->args, Lisp_Object *); + } +} + +DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function, + 1, /*dumpable_flag*/ + mark_compiled_function, + print_compiled_function, + finalize_compiled_function, + compiled_function_equal, + compiled_function_hash, + compiled_function_description, + Lisp_Compiled_Function); +#else /* not MC_ALLOC */ DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function, 1, /*dumpable_flag*/ mark_compiled_function, ＠＠ -2199,6 +2222,7 ＠＠ compiled_function_hash, compiled_function_description, Lisp_Compiled_Function); +#endif /* not MC_ALLOC */ DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /* Return t if OBJECT is a byte-compiled function object. diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/casetab.c mc-xemacs-21.5/src/casetab.c --- xemacs-21.5/src/casetab.c 2005-03-03 00:40:41.000000000 +0100 +++ mc-xemacs-21.5/src/casetab.c 2005-02-01 22:58:27.000000000 +0100 ＠＠ -116,7 +116,11 ＠＠ allocate_case_table (int init_tables) { Lisp_Case_Table *ct = +#ifdef MC_ALLOC + alloc_lrecord_type (Lisp_Case_Table, &lrecord_case_table); +#else /* not MC_ALLOC */ alloc_lcrecord_type (Lisp_Case_Table, &lrecord_case_table); +#endif /* not MC_ALLOC */ if (init_tables) { diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/casetab.h mc-xemacs-21.5/src/casetab.h --- xemacs-21.5/src/casetab.h 2005-03-03 00:40:41.000000000 +0100 +++ mc-xemacs-21.5/src/casetab.h 2005-02-01 22:58:27.000000000 +0100 ＠＠ -25,7 +25,11 ＠＠ struct Lisp_Case_Table { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object downcase_table; Lisp_Object upcase_table; Lisp_Object case_canon_table; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/charset.h mc-xemacs-21.5/src/charset.h --- xemacs-21.5/src/charset.h 2005-03-03 00:40:41.000000000 +0100 +++ mc-xemacs-21.5/src/charset.h 2005-02-01 22:58:22.000000000 +0100 ＠＠ -181,7 +181,11 ＠＠ struct Lisp_Charset { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ int id; Lisp_Object name; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/chartab.c mc-xemacs-21.5/src/chartab.c --- xemacs-21.5/src/chartab.c 2005-03-03 00:40:42.000000000 +0100 +++ mc-xemacs-21.5/src/chartab.c 2005-02-01 22:58:22.000000000 +0100 ＠＠ -476,7 +476,11 ＠＠ if (!EQ (ct->level1[i], Qnull_pointer) && CHAR_TABLE_ENTRYP (ct->level1[i]) && !OBJECT_DUMPED_P (ct->level1[1])) +#ifdef MC_ALLOC + free_lrecord (ct->level1[i]); +#else /* not MC_ALLOC */ free_lcrecord (ct->level1[i]); +#endif /* not MC_ALLOC */ ct->level1[i] = value; } #endif /* MULE */ ＠＠ -590,7 +594,11 ＠＠ Lisp_Object obj; enum char_table_type ty = symbol_to_char_table_type (type); +#ifdef MC_ALLOC + ct = alloc_lrecord_type (Lisp_Char_Table, &lrecord_char_table); +#else /* not MC_ALLOC */ ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table); +#endif /* not MC_ALLOC */ ct->type = ty; obj = wrap_char_table (ct); if (ty == CHAR_TABLE_TYPE_SYNTAX) ＠＠ -623,7 +631,11 ＠＠ { int i; Lisp_Char_Table_Entry *cte = +#ifdef MC_ALLOC + alloc_lrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry); +#else /* not MC_ALLOC */ alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry); +#endif /* not MC_ALLOC */ for (i = 0; i < 96; i++) cte->level2[i] = initval; ＠＠ -637,7 +649,11 ＠＠ Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); int i; Lisp_Char_Table_Entry *ctenew = +#ifdef MC_ALLOC + alloc_lrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry); +#else /* not MC_ALLOC */ alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry); +#endif /* not MC_ALLOC */ for (i = 0; i < 96; i++) { ＠＠ -666,7 +682,11 ＠＠ CHECK_CHAR_TABLE (char_table); ct = XCHAR_TABLE (char_table); +#ifdef MC_ALLOC + ctnew = alloc_lrecord_type (Lisp_Char_Table, &lrecord_char_table); +#else /* not MC_ALLOC */ ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table); +#endif /* not MC_ALLOC */ ctnew->type = ct->type; ctnew->parent = ct->parent; ctnew->default_ = ct->default_; ＠＠ -1055,7 +1075,11 ＠＠ int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; if (CHAR_TABLE_ENTRYP (ct->level1[lb]) && !OBJECT_DUMPED_P (ct->level1[lb])) +#ifdef MC_ALLOC + free_lrecord (ct->level1[lb]); +#else /* not MC_ALLOC */ free_lcrecord (ct->level1[lb]); +#endif /* not MC_ALLOC */ ct->level1[lb] = val; } break; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/chartab.h mc-xemacs-21.5/src/chartab.h --- xemacs-21.5/src/chartab.h 2005-03-03 00:40:42.000000000 +0100 +++ mc-xemacs-21.5/src/chartab.h 2005-02-01 22:58:22.000000000 +0100 ＠＠ -42,7 +42,11 ＠＠ struct Lisp_Char_Table_Entry { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ /* In the interests of simplicity, we just use a fixed 96-entry table. If we felt like being smarter, we could make this ＠＠ -80,7 +84,11 ＠＠ struct Lisp_Char_Table { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object ascii[NUM_ASCII_CHARS]; Lisp_Object default_; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/config.h.in mc-xemacs-21.5/src/config.h.in --- xemacs-21.5/src/config.h.in 2005-03-12 07:40:45.000000000 +0100 +++ mc-xemacs-21.5/src/config.h.in 2005-03-14 19:14:09.000000000 +0100 ＠＠ -678,6 +678,9 ＠＠ /* If defined, use experimental pdump-based GC algorithms. */ #undef USE_KKCC +/* If defined, use experimental allocator. */ +#undef MC_ALLOC + /* Enable special GNU Make features in the Makefiles. */ #undef USE_GNU_MAKE ＠＠ -748,6 +751,10 ＠＠ #undef PDUMP +/* Define DUMP_IN_EXEC to include the dump file in the executable + file. */ +#undef DUMP_IN_EXEC + /* Define DYNODUMP if it is necessary to properly dump on this system. Currently this is only Solaris 2.x, for x < 6. */ #undef DYNODUMP diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/console.c mc-xemacs-21.5/src/console.c --- xemacs-21.5/src/console.c 2005-03-03 00:40:45.000000000 +0100 +++ mc-xemacs-21.5/src/console.c 2005-03-08 02:49:39.000000000 +0100 ＠＠ -194,10 +194,18 ＠＠ allocate_console (Lisp_Object type) { Lisp_Object console; +#ifdef MC_ALLOC + struct console *con = alloc_lrecord_type (struct console, &lrecord_console); +#else /* not MC_ALLOC */ struct console *con = alloc_lcrecord_type (struct console, &lrecord_console); +#endif /* not MC_ALLOC */ struct gcpro gcpro1; +#ifdef MC_ALLOC + copy_lrecord (con, XCONSOLE (Vconsole_defaults)); +#else /* not MC_ALLOC */ copy_lcrecord (con, XCONSOLE (Vconsole_defaults)); +#endif /* not MC_ALLOC */ console = wrap_console (con); GCPRO1 (console); ＠＠ -662,7 +670,11 ＠＠ static void nuke_all_console_slots (struct console *con, Lisp_Object zap) { +#ifdef MC_ALLOC + zero_lrecord (con); +#else /* not MC_ALLOC */ zero_lcrecord (con); +#endif /* not MC_ALLOC */ #define MARKED_SLOT(x) con->x = zap; #include "conslots.h" ＠＠ -1311,6 +1323,31 ＠＠ } /* The docstrings for DEFVAR_* are recorded externally by make-docfile. */ +#ifdef MC_ALLOC +#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);*/ \ + \ + I_hate_C->magic.value = &(console_local_flags.field_name); \ + I_hate_C->magic.type = forward_type; \ + I_hate_C->magicfun = magic_fun; \ + \ + MARK_LRECORD_AS_LISP_READONLY (I_hate_C); \ + \ + { \ + int offset = ((char *)symbol_value_forward_forward (I_hate_C) \ + - (char *)&console_local_flags); \ + \ + defvar_magic (lname, I_hate_C); \ + \ + *((Lisp_Object *)(offset + (char *)XCONSOLE (Vconsole_local_symbols))) \ + = intern (lname); \ + } \ +} while (0) +#else /* not MC_ALLOC */ #define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magicfun) \ do { \ static const struct symbol_value_forward I_hate_C = \ ＠＠ -1343,6 +1380,7 ＠＠ = intern (lname); \ } \ } while (0) +#endif /* not MC_ALLOC */ #define DEFVAR_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \ DEFVAR_CONSOLE_LOCAL_1 (lname, field_name, \ ＠＠ -1367,8 +1405,13 ＠＠ /* Make sure all markable slots in console_defaults are initialized reasonably, so mark_console won't choke. */ +#ifdef MC_ALLOC + struct console *defs = alloc_lrecord_type (struct console, &lrecord_console); + struct console *syms = alloc_lrecord_type (struct console, &lrecord_console); +#else /* not MC_ALLOC */ struct console *defs = alloc_lcrecord_type (struct console, &lrecord_console); struct console *syms = alloc_lcrecord_type (struct console, &lrecord_console); +#endif /* not MC_ALLOC */ staticpro_nodump (&Vconsole_defaults); staticpro_nodump (&Vconsole_local_symbols); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/console-impl.h mc-xemacs-21.5/src/console-impl.h --- xemacs-21.5/src/console-impl.h 2005-03-03 00:40:43.000000000 +0100 +++ mc-xemacs-21.5/src/console-impl.h 2005-02-01 22:58:22.000000000 +0100 ＠＠ -408,7 +408,11 ＠＠ struct console { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ /* Description of this console's methods. */ struct console_methods *conmeths; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/console-msw-impl.h mc-xemacs-21.5/src/console-msw-impl.h --- xemacs-21.5/src/console-msw-impl.h 2005-03-03 00:40:43.000000000 +0100 +++ mc-xemacs-21.5/src/console-msw-impl.h 2005-02-01 22:58:22.000000000 +0100 ＠＠ -57,7 +57,11 ＠＠ struct Lisp_Devmode { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ /* Pointer to the DEVMODE structure */ DEVMODEW *devmode; ＠＠ -275,7 +279,11 ＠＠ struct mswindows_dialog_id { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object frame; Lisp_Object callbacks; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/database.c mc-xemacs-21.5/src/database.c --- xemacs-21.5/src/database.c 2005-03-11 02:43:10.000000000 +0100 +++ mc-xemacs-21.5/src/database.c 2005-03-11 01:33:33.000000000 +0100 ＠＠ -98,7 +98,11 ＠＠ struct Lisp_Database { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object fname; int mode; int access_; ＠＠ -131,7 +135,11 ＠＠ static Lisp_Database * allocate_database (void) { +#ifdef MC_ALLOC + Lisp_Database *db = alloc_lrecord_type (Lisp_Database, &lrecord_database); +#else /* not MC_ALLOC */ Lisp_Database *db = alloc_lcrecord_type (Lisp_Database, &lrecord_database); +#endif /* not MC_ALLOC */ db->fname = Qnil; db->live_p = 0; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/data.c mc-xemacs-21.5/src/data.c --- xemacs-21.5/src/data.c 2005-03-11 02:43:10.000000000 +0100 +++ mc-xemacs-21.5/src/data.c 2005-03-11 01:33:33.000000000 +0100 ＠＠ -2577,7 +2577,11 ＠＠ { Lisp_Object result; struct weak_list *wl = +#ifdef MC_ALLOC + alloc_lrecord_type (struct weak_list, &lrecord_weak_list); +#else /* not MC_ALLOC */ alloc_lcrecord_type (struct weak_list, &lrecord_weak_list); +#endif /* not MC_ALLOC */ wl->list = Qnil; wl->type = type; ＠＠ -3052,7 +3056,11 ＠＠ Lisp_Object result; struct weak_box *wb = +#ifdef MC_ALLOC + alloc_lrecord_type (struct weak_box, &lrecord_weak_box); +#else /* not MC_ALLOC */ alloc_lcrecord_type (struct weak_box, &lrecord_weak_box); +#endif /* not MC_ALLOC */ wb->value = value; result = wrap_weak_box (wb); ＠＠ -3275,7 +3283,11 ＠＠ struct gcpro gcpro1, gcpro2; struct ephemeron *eph = +#ifdef MC_ALLOC + alloc_lrecord_type (struct ephemeron, &lrecord_ephemeron); +#else /* not MC_ALLOC */ alloc_lcrecord_type (struct ephemeron, &lrecord_ephemeron); +#endif /* not MC_ALLOC */ eph->key = Qnil; eph->cons_chain = Qnil; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/depend mc-xemacs-21.5/src/depend --- xemacs-21.5/src/depend 2005-03-26 03:25:41.000000000 +0100 +++ mc-xemacs-21.5/src/depend 2005-03-26 03:29:55.000000000 +0100 ＠＠ -11,7 +11,7 ＠＠ LISP_H= #else CONFIG_H=config.h -LISP_H=lisp.h compiler.h config.h dumper.h general-slots.h lrecord.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h $(LISP_UNION_H) +LISP_H=lisp.h compiler.h config.h dumper.h general-slots.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h $(LISP_UNION_H) #endif #if defined(HAVE_MS_WINDOWS) ＠＠ -188,6 +188,7 ＠＠ macros.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console.h device.h events.h frame.h keymap.h macros.h redisplay.h scrollbar.h systime.h window.h malloc.o: $(CONFIG_H) getpagesize.h syssignal.h marker.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h +mc-alloc.o: $(LISP_H) md5.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h file-coding.h lstream.h menubar.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h frame-impl.h frame.h frameslots.h gui.h keymap.h menubar.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h minibuf.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console-stream.h console.h events.h frame-impl.h frame.h frameslots.h insdel.h redisplay.h scrollbar.h systime.h window-impl.h window.h winslots.h diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/device.c mc-xemacs-21.5/src/device.c --- xemacs-21.5/src/device.c 2005-03-03 00:40:46.000000000 +0100 +++ mc-xemacs-21.5/src/device.c 2005-02-03 22:02:40.000000000 +0100 ＠＠ -187,7 +187,11 ＠＠ static void nuke_all_device_slots (struct device *d, Lisp_Object zap) { +#ifdef MC_ALLOC + zero_lrecord (d); +#else /* not MC_ALLOC */ zero_lcrecord (d); +#endif /* not MC_ALLOC */ #define MARKED_SLOT(x) d->x = zap; #include "devslots.h" ＠＠ -197,7 +201,11 ＠＠ allocate_device (Lisp_Object console) { Lisp_Object device; +#ifdef MC_ALLOC + struct device *d = alloc_lrecord_type (struct device, &lrecord_device); +#else /* not MC_ALLOC */ struct device *d = alloc_lcrecord_type (struct device, &lrecord_device); +#endif /* not MC_ALLOC */ struct gcpro gcpro1; device = wrap_device (d); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/device-impl.h mc-xemacs-21.5/src/device-impl.h --- xemacs-21.5/src/device-impl.h 2005-03-03 00:40:45.000000000 +0100 +++ mc-xemacs-21.5/src/device-impl.h 2005-02-01 22:58:28.000000000 +0100 ＠＠ -71,7 +71,11 ＠＠ struct device { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ /* Methods for this device's console. This can also be retrieved through device->console, but it's faster this way. */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/device-msw.c mc-xemacs-21.5/src/device-msw.c --- xemacs-21.5/src/device-msw.c 2005-03-03 00:40:45.000000000 +0100 +++ mc-xemacs-21.5/src/device-msw.c 2005-02-01 22:58:29.000000000 +0100 ＠＠ -1188,7 +1188,11 ＠＠ { Lisp_Devmode *dm; +#ifdef MC_ALLOC + dm = alloc_lrecord_type (Lisp_Devmode, &lrecord_devmode); +#else /* not MC_ALLOC */ dm = alloc_lcrecord_type (Lisp_Devmode, &lrecord_devmode); +#endif /* not MC_ALLOC */ if (d) dm->device = wrap_device (d); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/dialog-msw.c mc-xemacs-21.5/src/dialog-msw.c --- xemacs-21.5/src/dialog-msw.c 2005-03-03 00:40:46.000000000 +0100 +++ mc-xemacs-21.5/src/dialog-msw.c 2005-02-01 22:58:28.000000000 +0100 ＠＠ -751,8 +751,13 ＠＠ Lisp_Object dialog_data; int i; struct mswindows_dialog_id *did = +#ifdef MC_ALLOC + alloc_lrecord_type (struct mswindows_dialog_id, + &lrecord_mswindows_dialog_id); +#else /* not MC_ALLOC */ alloc_lcrecord_type (struct mswindows_dialog_id, &lrecord_mswindows_dialog_id); +#endif /* not MC_ALLOC */ dialog_data = wrap_mswindows_dialog_id (did); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/dumper.c mc-xemacs-21.5/src/dumper.c --- xemacs-21.5/src/dumper.c 2005-03-29 14:36:26.000000000 +0200 +++ mc-xemacs-21.5/src/dumper.c 2005-03-29 14:40:18.000000000 +0200 ＠＠ -50,8 +50,10 ＠＠ #ifdef HAVE_MMAP #include <sys/mman.h> #endif +#ifdef DUMP_IN_EXEC #include "dump-data.h" #endif +#endif typedef struct { ＠＠ -235,6 +237,7 ＠＠ static Rawbyte *pdump_rt_list = 0; +#ifndef MC_ALLOC void pdump_objects_unmark (void) { ＠＠ -258,8 +261,27 ＠＠ break; } } +#endif /* not MC_ALLOC */ +#ifdef MC_ALLOC +/* The structure of the dump file looks like this: + 0 - header + - dumped objects + stab_offset - mc allocation table (count, size, address) for individual + allocation and relocation at load time. + - nb_cv_data*struct(dest, adr) for in-object externally + represented data + - nb_cv_ptr*(adr) for pointed-to externally represented data + - relocation table + - nb_root_struct_ptrs*struct(void *, adr) + for global pointers to structures + - nb_root_blocks*struct(void *, size, info) for global + objects to restore + - root lisp object address/value couples with the count + preceding the list + */ +#else /* not MC_ALLOC */ /* The structure of the dump file looks like this: 0 - header - dumped objects ＠＠ -274,6 +296,7 ＠＠ - root lisp object address/value couples with the count preceding the list */ +#endif /* not MC_ALLOC */ #define PDUMP_SIGNATURE "XEmacsDP" ＠＠ -411,7 +434,13 ＠＠ static void *pdump_buf; static FILE *pdump_out; +#if defined (MC_ALLOC) +/* With mc_alloc, way more entries are added to the hash tables: + increase hash table size to avoid collisions. */ +#define PDUMP_HASHSIZE 1000001 +#else /* not MC_ALLOC */ #define PDUMP_HASHSIZE 200001 +#endif /* not MC_ALLOC */ static pdump_block_list_elt **pdump_hash; ＠＠ -419,7 +448,12 ＠＠ static int pdump_make_hash (const void *obj) { +#if defined (MC_ALLOC) + /* Use >>2 for a better hash to avoid collisions. */ + return ((unsigned long)(obj)>>2) % PDUMP_HASHSIZE; +#else /* not MC_ALLOC */ return ((unsigned long)(obj)>>3) % PDUMP_HASHSIZE; +#endif /* not MC_ALLOC */ } /* Return the entry for an already-registered memory block at OBJ, ＠＠ -484,6 +518,71 ＠＠ } } +#ifdef MC_ALLOC +typedef struct mc_addr_elt +{ + const void *obj; + EMACS_INT addr; +} mc_addr_elt; + +static mc_addr_elt *pdump_mc_hash; + +/* Return the entry for an already-registered memory block at OBJ, + or NULL if none. */ +static EMACS_INT +pdump_get_mc_addr (const void *obj) +{ + int pos = pdump_make_hash (obj); + mc_addr_elt *mc_addr; + + assert (obj != 0); + + while ((mc_addr = &pdump_mc_hash[pos]) && (mc_addr->obj != 0)) + { + if (mc_addr->obj == obj) + return mc_addr->addr; + + pos++; + if (pos == PDUMP_HASHSIZE) + pos = 0; + } + + /* If this code is reached, an heap address occurred which has not + been written to the lookup table before. + This is a bug! */ + ABORT(); + return 0; +} + +/* For indirect address lookups, needed for convertibles: Ptr points + to an address within an object. Indirect gives the offset by how + many bytes the address of the object has to be adjusted to do a + lookup in the mc_addr translation table and get the new location of + the data. */ +#define pdump_get_indirect_mc_addr(ptr, indirect) \ + pdump_get_mc_addr ((void *)((ptr) - indirect)) + indirect + +static void +pdump_put_mc_addr (const void *obj, EMACS_INT addr) +{ + mc_addr_elt *mc_addr; + int pos = pdump_make_hash (obj); + + while ((mc_addr = &pdump_mc_hash[pos]) && (mc_addr->obj != 0)) + { + if (mc_addr->obj == obj) + return; + + pos++; + if (pos == PDUMP_HASHSIZE) + pos = 0; + } + + pdump_mc_hash[pos].obj = obj; + pdump_mc_hash[pos].addr = addr; +} +#endif /* MC_ALLOC */ + static pdump_block_list * pdump_get_block_list (const struct memory_description *desc) { ＠＠ -1031,6 +1130,207 ＠＠ retry_fwrite (desc ? pdump_buf : elt->obj, size, count, pdump_out); } +#ifdef MC_ALLOC +/* To be able to relocate during load time, more information about the + dumped objects are needed: The count (for array-like data + structures), the size of the object, and the location in the dumped + data. + */ +static void +pdump_dump_mc_data (pdump_block_list_elt *elt, + const struct memory_description *UNUSED(desc)) +{ + EMACS_INT rdata = pdump_get_block (elt->obj)->save_offset; + int j; + PDUMP_WRITE_ALIGNED (int, elt->count); + PDUMP_WRITE_ALIGNED (Bytecount, elt->size); + for (j = 0; j < elt->count; j++) + { + PDUMP_WRITE_ALIGNED (EMACS_INT, rdata); + rdata += elt->size; + } +} + +static void +pdump_scan_lisp_objects_by_alignment (void (*f) + (pdump_block_list_elt *, + const struct memory_description *)) +{ + int align; + + for (align = ALIGNOF (max_align_t); align; align>>=1) + { + int i; + pdump_block_list_elt *elt; + + for (i=0; i<lrecord_type_count; i++) + if (pdump_object_table[i].align == align) + for (elt = pdump_object_table[i].first; elt; elt = elt->next) + { + assert (elt->count == 1); + f (elt, lrecord_implementations_table[i]->description); + } + } +} + +static void +pdump_scan_non_lisp_objects_by_alignment (void (*f) + (pdump_block_list_elt *, + const struct memory_description *)) +{ + int align; + + for (align = ALIGNOF (max_align_t); align; align>>=1) + { + int i; + pdump_block_list_elt *elt; + + for (i=0; i<pdump_desc_table.count; i++) + { + pdump_desc_list_elt list = pdump_desc_table.list[i]; + if (list.list.align == align) + for (elt = list.list.first; elt; elt = elt->next) + f (elt, list.desc); + } + + for (elt = pdump_opaque_data_list.first; elt; elt = elt->next) + if (pdump_size_to_align (elt->size) == align) + f (elt, 0); + } +} + + + +static void +pdump_reloc_one_mc (void *data, const struct memory_description *desc) +{ + int pos; + + for (pos = 0; desc[pos].type != XD_END; pos++) + { + const struct memory_description *desc1 = &desc[pos]; + void *rdata = + (Rawbyte *) data + lispdesc_indirect_count (desc1->offset, + desc, data); + + union_switcheroo: + + /* If the flag says don't dump, then don't dump. */ + if ((desc1->flags) & XD_FLAG_NO_PDUMP) + continue; + + switch (desc1->type) + { + case XD_BYTECOUNT: + case XD_ELEMCOUNT: + case XD_HASHCODE: + case XD_INT: + case XD_LONG: + case XD_INT_RESET: + break; + case XD_OPAQUE_DATA_PTR: + case XD_ASCII_STRING: + case XD_BLOCK_PTR: + case XD_LO_LINK: + { + EMACS_INT ptr = *(EMACS_INT *) rdata; + if (ptr) + *(EMACS_INT *) rdata = pdump_get_mc_addr ((void *) ptr); + break; + } + case XD_LISP_OBJECT: + { + Lisp_Object *pobj = (Lisp_Object *) rdata; + + assert (desc1->data1 == 0); + + if (POINTER_TYPE_P (XTYPE (*pobj)) + && ! EQ (*pobj, Qnull_pointer)) + *pobj = wrap_pointer_1 ((char *) pdump_get_mc_addr + (XPNTR (*pobj))); + break; + } + case XD_LISP_OBJECT_ARRAY: + { + EMACS_INT num = lispdesc_indirect_count (desc1->data1, desc, + data); + int j; + + for (j=0; j<num; j++) + { + Lisp_Object *pobj = (Lisp_Object *) rdata + j; + + if (POINTER_TYPE_P (XTYPE (*pobj)) + && ! EQ (*pobj, Qnull_pointer)) + *pobj = wrap_pointer_1 ((char *) pdump_get_mc_addr + (XPNTR (*pobj))); + } + break; + } + case XD_DOC_STRING: + { + EMACS_INT str = *(EMACS_INT *) rdata; + if (str > 0) + *(EMACS_INT *) rdata = pdump_get_mc_addr ((void *) str); + break; + } + case XD_BLOCK_ARRAY: + { + EMACS_INT num = lispdesc_indirect_count (desc1->data1, desc, + data); + int j; + const struct sized_memory_description *sdesc = + lispdesc_indirect_description (data, desc1->data2.descr); + Bytecount size = lispdesc_block_size (rdata, sdesc); + + /* Note: We are recursing over data in the block itself */ + for (j = 0; j < num; j++) + pdump_reloc_one_mc ((Rawbyte *) rdata + j * size, + sdesc->description); + + break; + } + case XD_UNION: + case XD_UNION_DYNAMIC_SIZE: + desc1 = lispdesc_process_xd_union (desc1, desc, data); + if (desc1) + goto union_switcheroo; + break; + + case XD_OPAQUE_PTR_CONVERTIBLE: + { + pdump_cv_ptr_load_info *p = pdump_loaded_cv_ptr + *(EMACS_INT *)rdata; + if (!p->adr) + p->adr = desc1->data2.funcs->deconvert(0, + pdump_start + p->save_offset, + p->size); + *(void **)rdata = p->adr; + break; + } + + case XD_OPAQUE_DATA_CONVERTIBLE: + { + EMACS_INT dest_offset = (EMACS_INT) rdata; + EMACS_INT indirect = + lispdesc_indirect_count (desc1->offset, desc, data); + pdump_cv_data_dump_info *p; + + for(p = pdump_loaded_cv_data; + pdump_get_indirect_mc_addr (p->dest_offset, indirect) + != dest_offset; + p++); + + desc1->data2.funcs->deconvert(rdata, pdump_start + p->save_offset, + p->size); + break; + } + + default: + pdump_unsupported_dump_type (desc1->type, 0); + } + } +} +#else /* not MC_ALLOC */ /* Relocate a single memory block at DATA, described by DESC, from its assumed load location to its actual one by adding DELTA to all pointers in the block. Does not recursively relocate any other memory blocks ＠＠ -1164,6 +1464,7 ＠＠ } } } +#endif /* not MC_ALLOC */ static void pdump_allocate_offset (pdump_block_list_elt *elt, ＠＠ -1775,11 +2076,25 ＠＠ fseek (pdump_out, header.stab_offset, SEEK_SET); +#ifdef MC_ALLOC + { + EMACS_INT zero = 0; + pdump_scan_lisp_objects_by_alignment (pdump_dump_mc_data); + PDUMP_WRITE_ALIGNED (EMACS_INT, zero); + pdump_scan_non_lisp_objects_by_alignment (pdump_dump_mc_data); + PDUMP_WRITE_ALIGNED (EMACS_INT, zero); + } +#endif /* MC_ALLOC */ pdump_dump_cv_data_info (); pdump_dump_cv_ptr_info (); +#ifdef MC_ALLOC + pdump_dump_rtables (); +#endif /* MC_ALLOC */ pdump_dump_root_block_ptrs (); pdump_dump_root_blocks (); +#ifndef MC_ALLOC pdump_dump_rtables (); +#endif /* not MC_ALLOC */ pdump_dump_root_lisp_objects (); retry_fclose (pdump_out); ＠＠ -1820,6 +2135,45 ＠＠ delta = ((EMACS_INT) pdump_start) - header->reloc_address; p = pdump_start + header->stab_offset; +#ifdef MC_ALLOC + pdump_mc_hash = xnew_array_and_zero (mc_addr_elt, PDUMP_HASHSIZE); + + /* Allocate space for each object individually. First the + Lisp_Objects, then the blocks. */ + count = 2; + for (;;) + { + int elt_count = PDUMP_READ_ALIGNED (p, int); + if (elt_count) + { + Rawbyte *mc_addr = 0; + Bytecount size = PDUMP_READ_ALIGNED (p, Bytecount); + for (i = 0; i < elt_count; i++) + { + EMACS_INT rdata = PDUMP_READ_ALIGNED (p, EMACS_INT); + + if (i == 0) + { + Bytecount real_size = size * elt_count; +#ifdef MC_ALLOC + if (count == 2) + mc_addr = (Rawbyte *) mc_alloc (real_size); + else +#endif /* not MC_ALLOC */ + mc_addr = (Rawbyte *) xmalloc_and_zero (real_size); + } + else + mc_addr += size; + + pdump_put_mc_addr ((void *) rdata, (EMACS_INT) mc_addr); + memcpy (mc_addr, (char *) rdata + delta, size); + } + } + else if (!(--count)) + break; + } +#endif /* MC_ALLOC */ + /* Get the cv_data array */ p = (Rawbyte *) ALIGN_PTR (p, pdump_cv_data_dump_info); pdump_loaded_cv_data = (pdump_cv_data_dump_info *)p; ＠＠ -1837,12 +2191,39 ＠＠ pdump_loaded_cv_ptr[i].adr = 0; } +#ifdef MC_ALLOC + /* Relocate the heap objects */ + pdump_rt_list = p; + count = 2; + for (;;) + { + pdump_reloc_table rt = PDUMP_READ_ALIGNED (p, pdump_reloc_table); + p = (Rawbyte *) ALIGN_PTR (p, Rawbyte *); + if (rt.desc) + { + char **reloc = (char **) p; + for (i = 0; i < rt.count; i++) + { + reloc[i] = (char *) pdump_get_mc_addr (reloc[i]); + pdump_reloc_one_mc (reloc[i], rt.desc); + } + p += rt.count * sizeof (char *); + } + else if (!(--count)) + break; + } +#endif /* MC_ALLOC */ + /* Put back the pdump_root_block_ptrs */ p = (Rawbyte *) ALIGN_PTR (p, pdump_static_pointer); for (i = 0; i < header->nb_root_block_ptrs; i++) { pdump_static_pointer ptr = PDUMP_READ (p, pdump_static_pointer); +#ifdef MC_ALLOC + (* ptr.address) = (Rawbyte *) pdump_get_mc_addr (ptr.value); +#else /* not MC_ALLOC */ (* ptr.address) = ptr.value + delta; +#endif /* not MC_ALLOC */ } /* Put back the pdump_root_blocks and relocate */ ＠＠ -1851,10 +2232,15 ＠＠ pdump_root_block info = PDUMP_READ_ALIGNED (p, pdump_root_block); memcpy ((void *) info.blockaddr, p, info.size); if (info.desc) +#ifdef MC_ALLOC + pdump_reloc_one_mc ((void *) info.blockaddr, info.desc); +#else /* not MC_ALLOC */ pdump_reloc_one ((void *) info.blockaddr, delta, info.desc); +#endif /* not MC_ALLOC */ p += info.size; } +#ifndef MC_ALLOC /* Relocate the heap objects */ pdump_rt_list = p; count = 2; ＠＠ -1875,6 +2261,7 ＠＠ else if (!(--count)) break; } +#endif /* not MC_ALLOC */ /* Put the pdump_root_lisp_objects variables in place */ i = PDUMP_READ_ALIGNED (p, Elemcount); ＠＠ -1884,7 +2271,12 ＠＠ pdump_static_Lisp_Object obj = PDUMP_READ (p, pdump_static_Lisp_Object); if (POINTER_TYPE_P (XTYPE (obj.value))) - obj.value = wrap_pointer_1 ((Rawbyte *) XPNTR (obj.value) + delta); +#ifdef MC_ALLOC + obj.value = wrap_pointer_1 ((Rawbyte *) pdump_get_mc_addr + (XPNTR (obj.value))); +#else /* not MC_ALLOC */ + obj.value = wrap_pointer_1 ((Rawbyte *) XPNTR (obj.value) + delta); +#endif /* not MC_ALLOC */ (* obj.address) = obj.value; } ＠＠ -1908,6 +2300,10 ＠＠ p += sizeof (Lisp_Object) * rt.count; } +#ifdef MC_ALLOC + xfree (pdump_mc_hash, mc_addr_elt *); +#endif /* MC_ALLOC */ + return 1; } ＠＠ -2069,6 +2465,7 ＠＠ return 1; } +#ifdef DUMP_IN_EXEC static int pdump_ram_try (void) { ＠＠ -2077,6 +2474,7 ＠＠ return pdump_load_check (); } +#endif #endif /* !WIN32_NATIVE */ ＠＠ -2160,12 +2558,14 ＠＠ Wexttext *w; const Wexttext *dir, *p; +#ifdef DUMP_IN_EXEC if (pdump_ram_try ()) { pdump_load_finish (); in_pdump = 0; return 1; } +#endif in_pdump = 1; dir = argv0; ＠＠ -2242,6 +2642,9 ＠＠ { pdump_load_finish (); in_pdump = 0; +#ifdef MC_ALLOC + pdump_free (); +#endif /* MC_ALLOC */ return 1; } ＠＠ -2252,6 +2655,9 ＠＠ { pdump_load_finish (); in_pdump = 0; +#ifdef MC_ALLOC + pdump_free (); +#endif /* MC_ALLOC */ return 1; } pdump_free (); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/dumper.h mc-xemacs-21.5/src/dumper.h --- xemacs-21.5/src/dumper.h 2005-03-03 00:40:47.000000000 +0100 +++ mc-xemacs-21.5/src/dumper.h 2005-02-18 23:56:00.000000000 +0100 ＠＠ -27,7 +27,9 ＠＠ BEGIN_C_DECLS +#ifndef MC_ALLOC void pdump_objects_unmark (void); +#endif /* not MC_ALLOC */ void pdump (void); int pdump_load (const Wexttext *argv0); void pdump_backtrace (void); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/elhash.c mc-xemacs-21.5/src/elhash.c --- xemacs-21.5/src/elhash.c 2005-03-11 02:43:11.000000000 +0100 +++ mc-xemacs-21.5/src/elhash.c 2005-03-11 01:33:34.000000000 +0100 ＠＠ -102,7 +102,11 ＠＠ struct Lisp_Hash_Table { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Elemcount size; Elemcount count; Elemcount rehash_count; ＠＠ -550,7 +554,11 ＠＠ enum hash_table_weakness weakness) { Lisp_Object hash_table; +#ifdef MC_ALLOC + Lisp_Hash_Table *ht = alloc_lrecord_type (Lisp_Hash_Table, &lrecord_hash_table); +#else /* not MC_ALLOC */ Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table); +#endif /* not MC_ALLOC */ ht->test_function = test_function; ht->hash_function = hash_function; ＠＠ -967,9 +975,14 ＠＠ (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); +#ifdef MC_ALLOC + Lisp_Hash_Table *ht = alloc_lrecord_type (Lisp_Hash_Table, &lrecord_hash_table); + copy_lrecord (ht, ht_old); +#else /* not MC_ALLOC */ + Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table); copy_lcrecord (ht, ht_old); +#endif /* not MC_ALLOC */ ht->hentries = xnew_array (htentry, ht_old->size + 1); memcpy (ht->hentries, ht_old->hentries, (ht_old->size + 1) * sizeof (htentry)); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/emacs.c mc-xemacs-21.5/src/emacs.c --- xemacs-21.5/src/emacs.c 2005-03-03 00:40:48.000000000 +0100 +++ mc-xemacs-21.5/src/emacs.c 2005-03-25 02:52:55.000000000 +0100 ＠＠ -456,9 +456,11 ＠＠ #include "console-msw.h" #endif +#ifdef DUMP_IN_EXEC #ifndef WIN32_NATIVE #include "dump-data.h" #endif +#endif /* For PATH_EXEC */ #include <paths.h> ＠＠ -909,6 +911,18 ＠＠ display_use = 0; inhibit_non_essential_conversion_operations = 1; +#ifdef MC_ALLOC +#ifndef PDUMP + if (!initialized) +#endif + { + init_mc_allocator (); +#ifdef MC_ALLOC_TYPE_STATS + init_lrecord_stats (); +#endif /* not MC_ALLOC_TYPE_STATS */ + } +#endif /* MC_ALLOC */ + #ifdef NeXT /* 19-Jun-1995 -baw * NeXT secret magic, ripped from Emacs-for-NS by Carl Edman ＠＠ -1003,10 +1017,10 ＠＠ alignment and max size of the inline data and quit */ if (argmatch (argv, argc, "-si", "--show-inline-info", 0, NULL, &skip_args)) { -#if defined (PDUMP) && !defined (WIN32_NATIVE) +#if defined (PDUMP) && defined (DUMP_IN_EXEC) && !defined (WIN32_NATIVE) printf ("%u %u\n", dumped_data_max_size (), dumped_data_align_offset ()); #else - printf ("Portable dumper not configured or windows native; -si just forces exit.\n"); + printf ("Portable dumper not configured for dumping into executable or windows native; -si just forces exit.\n"); #endif exit (0); } ＠＠ -1424,6 +1438,9 ＠＠ syms_of_abbrev (); syms_of_alloc (); +#ifdef MC_ALLOC + syms_of_mc_alloc (); +#endif /* MC_ALLOC */ syms_of_buffer (); syms_of_bytecode (); syms_of_callint (); ＠＠ -1831,7 +1848,9 ＠＠ { reinit_alloc_early (); reinit_symbols_early (); +#ifndef MC_ALLOC reinit_opaque_early (); +#endif /* not MC_ALLOC */ reinit_eistring_early (); reinit_console_type_create_stream (); ＠＠ -2244,7 +2263,9 ＠＠ reinit_vars_of_glyphs_widget (); reinit_vars_of_insdel (); reinit_vars_of_lread (); +#ifndef MC_ALLOC reinit_vars_of_lstream (); +#endif /* not MC_ALLOC */ reinit_vars_of_minibuf (); #ifdef HAVE_SHLIB reinit_vars_of_module (); ＠＠ -3169,7 +3190,9 ＠＠ fflush (stdout); disksave_object_finalization (); +#ifndef MC_ALLOC release_breathing_space (); +#endif /* not MC_ALLOC */ /* Tell malloc where start of impure now is */ /* Also arrange for warnings when nearly out of space. */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/events.h mc-xemacs-21.5/src/events.h --- xemacs-21.5/src/events.h 2005-03-03 00:40:50.000000000 +0100 +++ mc-xemacs-21.5/src/events.h 2005-02-01 22:58:27.000000000 +0100 ＠＠ -639,7 +639,11 ＠＠ struct Lisp_Timeout { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ 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 ＠＠ -1088,7 +1092,11 ＠＠ */ struct command_builder { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object console; /* back pointer to the console this command builder is for */ #if 0 diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/event-stream.c mc-xemacs-21.5/src/event-stream.c --- xemacs-21.5/src/event-stream.c 2005-03-03 00:40:50.000000000 +0100 +++ mc-xemacs-21.5/src/event-stream.c 2005-02-01 22:58:28.000000000 +0100 ＠＠ -331,7 +331,9 ＠＠ #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder) #define CONCHECK_COMMAND_BUILDER(x) CONCHECK_RECORD (x, command_builder) +#ifndef MC_ALLOC static Lisp_Object Vcommand_builder_free_list; +#endif /* not MC_ALLOC */ static const struct memory_description command_builder_description [] = { { XD_LISP_OBJECT, offsetof (struct command_builder, current_events) }, ＠＠ -389,7 +391,12 ＠＠ allocate_command_builder (Lisp_Object console, int with_echo_buf) { Lisp_Object builder_obj = +#ifdef MC_ALLOC + wrap_pointer_1 (alloc_lrecord_type (struct command_builder, + &lrecord_command_builder)); +#else /* not MC_ALLOC */ alloc_managed_lcrecord (Vcommand_builder_free_list); +#endif /* not MC_ALLOC */ struct command_builder *builder = XCOMMAND_BUILDER (builder_obj); builder->console = console; ＠＠ -458,8 +465,12 ＠＠ xfree (builder->echo_buf, Ibyte *); builder->echo_buf = NULL; } +#ifdef MC_ALLOC + free_lrecord (wrap_command_builder (builder)); +#else /* not MC_ALLOC */ free_managed_lcrecord (Vcommand_builder_free_list, wrap_command_builder (builder)); +#endif /* not MC_ALLOC */ } static void ＠＠ -1022,7 +1033,9 ＠＠ static Lisp_Object pending_timeout_list, pending_async_timeout_list; +#ifndef MC_ALLOC static Lisp_Object Vtimeout_free_list; +#endif /* not MC_ALLOC */ static Lisp_Object mark_timeout (Lisp_Object obj) ＠＠ -1051,7 +1064,12 ＠＠ Lisp_Object function, Lisp_Object object, int async_p) { +#ifdef MC_ALLOC + Lisp_Object op = + wrap_pointer_1 (alloc_lrecord_type (Lisp_Timeout, &lrecord_timeout)); +#else /* not MC_ALLOC */ Lisp_Object op = alloc_managed_lcrecord (Vtimeout_free_list); +#endif /* not MC_ALLOC */ Lisp_Timeout *timeout = XTIMEOUT (op); EMACS_TIME current_time; EMACS_TIME interval; ＠＠ -1169,7 +1187,11 ＠＠ *timeout_list = noseeum_cons (op, *timeout_list); } else +#ifdef MC_ALLOC + free_lrecord (op); +#else /* not MC_ALLOC */ free_managed_lcrecord (Vtimeout_free_list, op); +#endif /* not MC_ALLOC */ UNGCPRO; return id; ＠＠ -1206,7 +1228,11 ＠＠ signal_remove_async_interval_timeout (timeout->interval_id); else event_stream_remove_timeout (timeout->interval_id); +#ifdef MC_ALLOC + free_lrecord (op); +#else /* not MC_ALLOC */ free_managed_lcrecord (Vtimeout_free_list, op); +#endif /* not MC_ALLOC */ } } ＠＠ -4743,6 +4769,7 ＠＠ recent_keys_ring_index = 0; recent_keys_ring_size = 100; num_input_chars = 0; +#ifndef MC_ALLOC Vtimeout_free_list = make_lcrecord_list (sizeof (Lisp_Timeout), &lrecord_timeout); staticpro_nodump (&Vtimeout_free_list); ＠＠ -4750,6 +4777,7 ＠＠ make_lcrecord_list (sizeof (struct command_builder), &lrecord_command_builder); staticpro_nodump (&Vcommand_builder_free_list); +#endif /* not MC_ALLOC */ the_low_level_timeout_blocktype = Blocktype_new (struct low_level_timeout_blocktype); something_happened = 0; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/extents.c mc-xemacs-21.5/src/extents.c --- xemacs-21.5/src/extents.c 2005-03-03 00:40:51.000000000 +0100 +++ mc-xemacs-21.5/src/extents.c 2005-02-03 22:02:49.000000000 +0100 ＠＠ -986,10 +986,17 ＠＠ allocate_extent_auxiliary (EXTENT ext) { Lisp_Object extent_aux; +#ifdef MC_ALLOC + struct extent_auxiliary *data = + alloc_lrecord_type (struct extent_auxiliary, &lrecord_extent_auxiliary); + + copy_lrecord (data, &extent_auxiliary_defaults); +#else /* not MC_ALLOC */ struct extent_auxiliary *data = alloc_lcrecord_type (struct extent_auxiliary, &lrecord_extent_auxiliary); copy_lcrecord (data, &extent_auxiliary_defaults); +#endif /* not MC_ALLOC */ extent_aux = wrap_extent_auxiliary (data); ext->plist = Fcons (extent_aux, ext->plist); ext->flags.has_aux = 1; ＠＠ -1167,7 +1174,11 ＠＠ { Lisp_Object extent_info; struct extent_info *data = +#ifdef MC_ALLOC + alloc_lrecord_type (struct extent_info, &lrecord_extent_info); +#else /* not MC_ALLOC */ alloc_lcrecord_type (struct extent_info, &lrecord_extent_info); +#endif /* not MC_ALLOC */ extent_info = wrap_extent_info (data); data->extents = allocate_extent_list (); ＠＠ -3898,11 +3909,19 ＠＠ /* also need to copy the aux struct. It won't work for this extent to share the same aux struct as the original one. */ +#ifdef MC_ALLOC + struct extent_auxiliary *data = + alloc_lrecord_type (struct extent_auxiliary, + &lrecord_extent_auxiliary); + + copy_lrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist))); +#else /* not MC_ALLOC */ struct extent_auxiliary *data = alloc_lcrecord_type (struct extent_auxiliary, &lrecord_extent_auxiliary); copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist))); +#endif /* not MC_ALLOC */ XCAR (e->plist) = wrap_extent_auxiliary (data); } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/extents-impl.h mc-xemacs-21.5/src/extents-impl.h --- xemacs-21.5/src/extents-impl.h 2005-03-03 00:40:50.000000000 +0100 +++ mc-xemacs-21.5/src/extents-impl.h 2005-02-01 22:58:28.000000000 +0100 ＠＠ -103,7 +103,11 ＠＠ typedef struct extent_auxiliary extent_auxiliary; struct extent_auxiliary { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object begin_glyph; Lisp_Object end_glyph; ＠＠ -129,7 +133,11 ＠＠ struct extent_info { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ struct extent_list *extents; struct stack_of_extents *soe; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/faces.c mc-xemacs-21.5/src/faces.c --- xemacs-21.5/src/faces.c 2005-03-03 00:40:51.000000000 +0100 +++ mc-xemacs-21.5/src/faces.c 2005-02-01 22:58:22.000000000 +0100 ＠＠ -371,7 +371,11 ＠＠ static Lisp_Face * allocate_face (void) { +#ifdef MC_ALLOC + Lisp_Face *result = alloc_lrecord_type (Lisp_Face, &lrecord_face); +#else /* not MC_ALLOC */ Lisp_Face *result = alloc_lcrecord_type (Lisp_Face, &lrecord_face); +#endif /* not MC_ALLOC */ reset_face (result); return result; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/faces.h mc-xemacs-21.5/src/faces.h --- xemacs-21.5/src/faces.h 2005-03-03 00:40:51.000000000 +0100 +++ mc-xemacs-21.5/src/faces.h 2005-02-01 22:58:22.000000000 +0100 ＠＠ -33,7 +33,11 ＠＠ struct Lisp_Face { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object name; Lisp_Object doc_string; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/file-coding.c mc-xemacs-21.5/src/file-coding.c --- xemacs-21.5/src/file-coding.c 2005-03-03 00:40:52.000000000 +0100 +++ mc-xemacs-21.5/src/file-coding.c 2005-02-03 22:02:51.000000000 +0100 ＠＠ -698,8 +698,13 ＠＠ { Bytecount total_size = offsetof (Lisp_Coding_System, data) + data_size; Lisp_Coding_System *codesys = +#ifdef MC_ALLOC + (Lisp_Coding_System *) alloc_lrecord (total_size, + &lrecord_coding_system); +#else /* not MC_ALLOC */ (Lisp_Coding_System *) basic_alloc_lcrecord (total_size, &lrecord_coding_system); +#endif /* not MC_ALLOC */ codesys->methods = codesys_meths; #define MARKED_SLOT(x) codesys->x = Qnil; ＠＠ -1404,7 +1409,11 ＠＠ { Lisp_Coding_System *to = XCODING_SYSTEM (new_coding_system); Lisp_Coding_System *from = XCODING_SYSTEM (old_coding_system); +#ifdef MC_ALLOC + copy_sized_lrecord (to, from, sizeof_coding_system (from)); +#else /* not MC_ALLOC */ copy_sized_lcrecord (to, from, sizeof_coding_system (from)); +#endif /* not MC_ALLOC */ to->name = new_name; } return new_coding_system; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/file-coding.h mc-xemacs-21.5/src/file-coding.h --- xemacs-21.5/src/file-coding.h 2005-03-03 00:40:52.000000000 +0100 +++ mc-xemacs-21.5/src/file-coding.h 2005-02-01 22:58:28.000000000 +0100 ＠＠ -188,7 +188,11 ＠＠ struct Lisp_Coding_System { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ struct coding_system_methods *methods; #define CODING_SYSTEM_SLOT_DECLARATION diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/fns.c mc-xemacs-21.5/src/fns.c --- xemacs-21.5/src/fns.c 2005-03-03 00:40:53.000000000 +0100 +++ mc-xemacs-21.5/src/fns.c 2005-02-01 22:58:21.000000000 +0100 ＠＠ -2959,8 +2959,8 ＠＠ Ibyte *end; CHECK_CHAR_COERCE_INT (item); - CHECK_LISP_WRITEABLE (array); + CHECK_LISP_WRITEABLE (array); sledgehammer_check_ascii_begin (array); item_bytecount = set_itext_ichar (item_buf, XCHAR (item)); new_bytecount = item_bytecount * (Bytecount) string_char_length (array); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/frame.c mc-xemacs-21.5/src/frame.c --- xemacs-21.5/src/frame.c 2005-03-24 15:18:31.000000000 +0100 +++ mc-xemacs-21.5/src/frame.c 2005-03-24 15:13:54.000000000 +0100 ＠＠ -259,7 +259,11 ＠＠ static void nuke_all_frame_slots (struct frame *f) { +#ifdef MC_ALLOC + zero_lrecord (f); +#else /* not MC_ALLOC */ zero_lcrecord (f); +#endif /* not MC_ALLOC */ #define MARKED_SLOT(x) f->x = Qnil; #include "frameslots.h" ＠＠ -275,7 +279,11 ＠＠ /* This function can GC */ Lisp_Object frame; Lisp_Object root_window; +#ifdef MC_ALLOC + struct frame *f = alloc_lrecord_type (struct frame, &lrecord_frame); +#else /* not MC_ALLOC */ struct frame *f = alloc_lcrecord_type (struct frame, &lrecord_frame); +#endif /* not MC_ALLOC */ nuke_all_frame_slots (f); frame = wrap_frame (f); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/frame-impl.h mc-xemacs-21.5/src/frame-impl.h --- xemacs-21.5/src/frame-impl.h 2005-03-03 00:40:53.000000000 +0100 +++ mc-xemacs-21.5/src/frame-impl.h 2005-02-01 22:58:25.000000000 +0100 ＠＠ -41,7 +41,11 ＠＠ struct frame { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ /* Methods for this frame's console. This can also be retrieved through frame->device->console, but it's faster this way. */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/glyphs.c mc-xemacs-21.5/src/glyphs.c --- xemacs-21.5/src/glyphs.c 2005-03-03 00:40:55.000000000 +0100 +++ mc-xemacs-21.5/src/glyphs.c 2005-02-03 22:02:54.000000000 +0100 ＠＠ -1310,7 +1310,11 ＠＠ Lisp_Object instantiator) { Lisp_Image_Instance *lp = +#ifdef MC_ALLOC + alloc_lrecord_type (Lisp_Image_Instance, &lrecord_image_instance); +#else /* not MC_ALLOC */ alloc_lcrecord_type (Lisp_Image_Instance, &lrecord_image_instance); +#endif /* not MC_ALLOC */ Lisp_Object val; /* It's not possible to simply keep a record of the domain in which ＠＠ -1976,7 +1980,11 ＠＠ device-specific method to copy the window-system subobject. */ new = allocate_image_instance (XIMAGE_INSTANCE_DOMAIN (image_instance), Qnil, Qnil); +#ifdef MC_ALLOC + copy_lrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance)); +#else /* not MC_ALLOC */ copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance)); +#endif /* not MC_ALLOC */ /* 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. */ ＠＠ -3789,7 +3797,11 ＠＠ { /* This function can GC */ Lisp_Object obj = Qnil; +#ifdef MC_ALLOC + Lisp_Glyph *g = alloc_lrecord_type (Lisp_Glyph, &lrecord_glyph); +#else /* not MC_ALLOC */ Lisp_Glyph *g = alloc_lcrecord_type (Lisp_Glyph, &lrecord_glyph); +#endif /* not MC_ALLOC */ g->type = type; g->image = Fmake_specifier (Qimage); /* This function can GC */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/glyphs.h mc-xemacs-21.5/src/glyphs.h --- xemacs-21.5/src/glyphs.h 2005-03-03 00:40:56.000000000 +0100 +++ mc-xemacs-21.5/src/glyphs.h 2005-02-01 22:58:27.000000000 +0100 ＠＠ -594,7 +594,11 ＠＠ struct Lisp_Image_Instance { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ 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 ＠＠ -946,7 +950,11 ＠＠ struct Lisp_Glyph { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ enum glyph_type type; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/gpmevent.c mc-xemacs-21.5/src/gpmevent.c --- xemacs-21.5/src/gpmevent.c 2005-03-03 00:40:56.000000000 +0100 +++ mc-xemacs-21.5/src/gpmevent.c 2005-02-01 22:58:25.000000000 +0100 ＠＠ -59,6 +59,10 ＠＠ static Lisp_Object gpm_event_queue; static Lisp_Object gpm_event_queue_tail; +#ifdef MC_ALLOC +static Lisp_Object MC_ALLOC_Freceive_gpm_event; +#endif /* MC_ALLOC */ + struct __gpm_state { int gpm_tried; ＠＠ -593,7 +597,11 ＠＠ { rval = 0; Fprocess_kill_without_query (gpm_process, Qnil); +#ifdef MC_ALLOC + gpm_filter = MC_ALLOC_Freceive_gpm_event; +#else /* not MC_ALLOC */ gpm_filter = wrap_subr (&SFreceive_gpm_event); +#endif /* not MC_ALLOC */ set_process_filter (gpm_process, gpm_filter, 1, 0); /* Keep track of the device for later */ ＠＠ -621,7 +629,17 ＠＠ void syms_of_gpmevent (void) { +#ifdef MC_ALLOC +#define DEFSUBR_receive_gpm_event(Fname) \ +do { \ + DEFSUBR_MC_ALLOC (Fname); \ + defsubr (S##Fname); \ + MC_ALLOC_Freceive_gpm_event = wrap_subr (S##Fname); \ +} while (0) + DEFSUBR_receive_gpm_event (Freceive_gpm_event); +#else /* not MC_ALLOC */ DEFSUBR (Freceive_gpm_event); +#endif /* not MC_ALLOC */ DEFSUBR (Fgpm_enable); DEFSUBR (Fgpm_enabled_p); } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/gui.c mc-xemacs-21.5/src/gui.c --- xemacs-21.5/src/gui.c 2005-03-03 00:40:56.000000000 +0100 +++ mc-xemacs-21.5/src/gui.c 2005-02-01 22:58:21.000000000 +0100 ＠＠ -197,7 +197,11 ＠＠ Lisp_Object allocate_gui_item (void) { +#ifdef MC_ALLOC + Lisp_Gui_Item *lp = alloc_lrecord_type (Lisp_Gui_Item, &lrecord_gui_item); +#else /* not MC_ALLOC */ Lisp_Gui_Item *lp = alloc_lcrecord_type (Lisp_Gui_Item, &lrecord_gui_item); +#endif /* not MC_ALLOC */ Lisp_Object val; val = wrap_gui_item (lp); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/gui.h mc-xemacs-21.5/src/gui.h --- xemacs-21.5/src/gui.h 2005-03-03 00:40:56.000000000 +0100 +++ mc-xemacs-21.5/src/gui.h 2005-02-01 22:58:21.000000000 +0100 ＠＠ -44,7 +44,11 ＠＠ menu item or submenu properties */ struct Lisp_Gui_Item { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object name; /* String */ Lisp_Object callback; /* Symbol or form */ Lisp_Object callback_ex; /* Form taking context arguments */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/keymap.c mc-xemacs-21.5/src/keymap.c --- xemacs-21.5/src/keymap.c 2005-03-03 00:40:58.000000000 +0100 +++ mc-xemacs-21.5/src/keymap.c 2005-02-01 22:58:29.000000000 +0100 ＠＠ -148,7 +148,11 ＠＠ struct Lisp_Keymap { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object parents; /* Keymaps to be searched after this one. An ordered list */ Lisp_Object prompt; /* Qnil or a string to print in the minibuffer ＠＠ -756,7 +760,11 ＠＠ make_keymap (Elemcount size) { Lisp_Object result; +#ifdef MC_ALLOC + Lisp_Keymap *keymap = alloc_lrecord_type (Lisp_Keymap, &lrecord_keymap); +#else /* not MC_ALLOC */ Lisp_Keymap *keymap = alloc_lcrecord_type (Lisp_Keymap, &lrecord_keymap); +#endif /* not MC_ALLOC */ result = wrap_keymap (keymap); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/lisp.h mc-xemacs-21.5/src/lisp.h --- xemacs-21.5/src/lisp.h 2005-03-13 20:05:37.000000000 +0100 +++ mc-xemacs-21.5/src/lisp.h 2005-03-25 03:43:22.000000000 +0100 ＠＠ -1750,8 +1750,13 ＠＠ #define CHECK_CONS(x) CHECK_RECORD (x, cons) #define CONCHECK_CONS(x) CONCHECK_RECORD (x, cons) +#ifdef MC_ALLOC +#define CONS_MARKED_P(c) MARKED_P (&((c)->lheader)) +#define MARK_CONS(c) MARK (&((c)->lheader)) +#else /* not MC_ALLOC */ #define CONS_MARKED_P(c) MARKED_RECORD_HEADER_P(&((c)->lheader)) #define MARK_CONS(c) MARK_RECORD_HEADER (&((c)->lheader)) +#endif /* not MC_ALLOC */ extern MODULE_API Lisp_Object Qnil; ＠＠ -2283,12 +2288,20 ＠＠ /* WARNING: Everything before ascii_begin must agree exactly with struct lrecord_header */ unsigned int type :8; +#ifdef MC_ALLOC + unsigned int lisp_readonly :1; + unsigned int free :1; + /* Number of chars at beginning of string that are one byte in length + (byte_ascii_p) */ + unsigned int ascii_begin :22; +#else /* not MC_ALLOC */ unsigned int mark :1; unsigned int c_readonly :1; unsigned int lisp_readonly :1; /* Number of chars at beginning of string that are one byte in length (byte_ascii_p) */ unsigned int ascii_begin :21; +#endif /* not MC_ALLOC */ } v; } u; Bytecount size_; ＠＠ -2355,7 +2368,11 ＠＠ struct Lisp_Vector { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ long size; Lisp_Object contents[1]; }; ＠＠ -2392,7 +2409,11 ＠＠ struct Lisp_Bit_Vector { +#ifdef MC_ALLOC + struct lrecord_header lheader; +#else /* MC_ALLOC */ struct lcrecord_header lheader; +#endif /* MC_ALLOC */ Elemcount size; unsigned long bits[1]; }; ＠＠ -2696,13 +2717,16 ＠＠ /*--------------------------- readonly objects -------------------------*/ +#ifndef MC_ALLOC #define CHECK_C_WRITEABLE(obj) \ do { if (c_readonly (obj)) c_write_error (obj); } while (0) +#define C_READONLY(obj) (C_READONLY_RECORD_HEADER_P(XRECORD_LHEADER (obj))) +#endif /* not MC_ALLOC */ + #define CHECK_LISP_WRITEABLE(obj) \ do { if (lisp_readonly (obj)) lisp_write_error (obj); } while (0) -#define C_READONLY(obj) (C_READONLY_RECORD_HEADER_P(XRECORD_LHEADER (obj))) #define LISP_READONLY(obj) (LISP_READONLY_RECORD_HEADER_P(XRECORD_LHEADER (obj))) /*----------------------------- structures ----------------------------*/ ＠＠ -2750,7 +2774,11 ＠＠ struct weak_box { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object value; Lisp_Object next_weak_box; /* don't mark through this! */ ＠＠ -2772,7 +2800,11 ＠＠ struct ephemeron { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object key; ＠＠ -2831,7 +2863,11 ＠＠ struct weak_list { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object list; /* don't mark through this! */ enum weak_list_type type; Lisp_Object next_weak; /* don't mark through this! */ ＠＠ -2940,6 +2976,45 ＠＠ /* Can't be const, because then subr->doc is read-only and Snarf_documentation chokes */ +#ifdef MC_ALLOC +#define DEFUN(lname, Fname, min_args, max_args, prompt, arglist) \ + Lisp_Object Fname (EXFUN_##max_args); \ + static struct Lisp_Subr MC_ALLOC_S##Fname = \ + { \ + { /* struct lrecord_header */ \ + lrecord_type_subr, /* lrecord_type_index */ \ + 1, /* lisp_readonly bit */ \ + 0, /* free */ \ + 0 /* uid */ \ + }, \ + min_args, \ + max_args, \ + prompt, \ + 0, /* doc string */ \ + lname, \ + (lisp_fn_t) Fname \ + }; \ + Lisp_Object Fname (DEFUN_##max_args arglist) + +#define DEFUN_NORETURN(lname, Fname, min_args, max_args, prompt, arglist) \ + DECLARE_DOESNT_RETURN_TYPE (Lisp_Object, Fname (EXFUN_##max_args)); \ + static struct Lisp_Subr MC_ALLOC_S##Fname = \ + { \ + { /* struct lrecord_header */ \ + lrecord_type_subr, /* lrecord_type_index */ \ + 1, /* lisp_readonly bit */ \ + 0, /* free */ \ + 0 /* uid */ \ + }, \ + min_args, \ + max_args, \ + prompt, \ + 0, /* doc string */ \ + lname, \ + (lisp_fn_t) Fname \ + }; \ + DOESNT_RETURN_TYPE (Lisp_Object) Fname (DEFUN_##max_args arglist) +#else /* not MC_ALLOC */ #define DEFUN(lname, Fname, min_args, max_args, prompt, arglist) \ Lisp_Object Fname (EXFUN_##max_args); \ static struct Lisp_Subr S##Fname = \ ＠＠ -2979,6 +3054,7 ＠＠ (lisp_fn_t) Fname \ }; \ DOESNT_RETURN_TYPE (Lisp_Object) Fname (DEFUN_##max_args arglist) +#endif /* not MC_ALLOC */ /* Heavy ANSI C preprocessor hackery to get DEFUN to declare a prototype that matches max_args, and add the obligatory ＠＠ -3483,6 +3559,18 ＠＠ #endif +#ifdef MC_ALLOC +extern Lisp_Object_dynarr *mcpros; +#ifdef DEBUG_XEMACS +/* Help debug crashes gc-marking a mcpro'ed object. */ +MODULE_API void mcpro_1 (Lisp_Object, char *); +#define mcpro(ptr) mcpro_1 (ptr, #ptr) +#else /* not DEBUG_XEMACS */ +/* Call mcpro (&var) to protect mc variable `var'. */ +MODULE_API void mcpro (Lisp_Object); +#endif /* not DEBUG_XEMACS */ +#endif /* MC_ALLOC */ + void register_post_gc_action (void (*fun) (void *), void *arg); int begin_gc_forbidden (void); void end_gc_forbidden (int count); ＠＠ -3539,7 +3627,9 ＠＠ MODULE_API EXFUN (Fmake_vector, 2); MODULE_API EXFUN (Fvector, MANY); +#ifndef MC_ALLOC void release_breathing_space (void); +#endif /* not MC_ALLOC */ Lisp_Object noseeum_cons (Lisp_Object, Lisp_Object); MODULE_API Lisp_Object make_vector (Elemcount, Lisp_Object); MODULE_API Lisp_Object vector1 (Lisp_Object); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/lrecord.h mc-xemacs-21.5/src/lrecord.h --- xemacs-21.5/src/lrecord.h 2005-03-03 00:40:59.000000000 +0100 +++ mc-xemacs-21.5/src/lrecord.h 2005-03-29 21:43:50.000000000 +0200 ＠＠ -26,6 +26,26 ＠＠ #ifndef INCLUDED_lrecord_h_ #define INCLUDED_lrecord_h_ +#ifdef MC_ALLOC +/* The "lrecord" type of Lisp object is used for all object types + other than a few simple ones (like char and int). This allows many + types to be implemented but only a few bits required in a Lisp + object for type information. (The tradeoff is that each object has + its type marked in it, thereby increasing its size.) All lrecords + begin with a `struct lrecord_header', which identifies the lisp + object type, by providing an index into a table of `struct + lrecord_implementation', which describes the behavior of the lisp + object. It also contains some other data bits. + + Creating a new lrecord type is fairly easy; just follow the + lead of some existing type (e.g. hash tables). Note that you + do not need to supply all the methods (see below); reasonable + defaults are provided for many of them. Alternatively, if you're + just looking for a way of encapsulating data (which possibly + could contain Lisp_Objects in it), you may well be able to use + the opaque type. +*/ +#else /* not MC_ALLOC */ /* The "lrecord" type of Lisp object is used for all object types other than a few simple ones. This allows many types to be implemented but only a few bits required in a Lisp object for type ＠＠ -59,6 +79,7 ＠＠ could contain Lisp_Objects in it), you may well be able to use the opaque type. --ben */ +#endif /* not MC_ALLOC */ BEGIN_C_DECLS ＠＠ -69,6 +90,21 ＠＠ field. */ unsigned int type :8; +#ifdef MC_ALLOC + /* 1 if the object is readonly from lisp */ + unsigned int lisp_readonly :1; + + /* The `free' field is a flag that indicates whether this lrecord + is currently free or not. This is used for error checking and + debugging. */ + unsigned int free :1; + + /* The `uid' field is just for debugging/printing convenience. + Having this slot doesn't hurt us much spacewise, since the + bits are unused anyway. */ + unsigned int uid :22; + +#else /* not MC_ALLOC */ /* If `mark' is 0 after the GC mark phase, the object will be freed during the GC sweep phase. There are 2 ways that `mark' can be 1: - by being referenced from other objects during the GC mark phase ＠＠ -85,11 +121,20 ＠＠ unsigned int unused :21; +#endif /* not MC_ALLOC */ }; struct lrecord_implementation; int lrecord_type_index (const struct lrecord_implementation *implementation); +#ifdef MC_ALLOC +#define set_lheader_implementation(header,imp) do { \ + struct lrecord_header* SLI_header = (header); \ + SLI_header->type = (imp)->lrecord_type_index; \ + SLI_header->lisp_readonly = 0; \ + SLI_header->free = 0; \ +} while (0) +#else /* not MC_ALLOC */ #define set_lheader_implementation(header,imp) do { \ struct lrecord_header* SLI_header = (header); \ SLI_header->type = (imp)->lrecord_type_index; \ ＠＠ -97,7 +142,9 ＠＠ SLI_header->c_readonly = 0; \ SLI_header->lisp_readonly = 0; \ } while (0) +#endif /* not MC_ALLOC */ +#ifndef MC_ALLOC struct lcrecord_header { struct lrecord_header lheader; ＠＠ -135,45 +182,47 ＠＠ struct lcrecord_header lcheader; Lisp_Object chain; }; +#endif /* not MC_ALLOC */ enum lrecord_type { /* Symbol value magic types come first to make SYMBOL_VALUE_MAGIC_P fast. #### This should be replaced by a symbol_value_magic_p flag in the Lisp_Symbol lrecord_header. */ - lrecord_type_symbol_value_forward, /* 0 */ - lrecord_type_symbol_value_varalias, /* 1 */ - lrecord_type_symbol_value_lisp_magic, /* 2 */ - lrecord_type_symbol_value_buffer_local, /* 3 */ + lrecord_type_symbol_value_forward, /* 0 */ + lrecord_type_symbol_value_varalias, /* 1 */ + lrecord_type_symbol_value_lisp_magic, /* 2 */ + lrecord_type_symbol_value_buffer_local, /* 3 */ lrecord_type_max_symbol_value_magic = lrecord_type_symbol_value_buffer_local, - - lrecord_type_symbol, /* 4 */ - lrecord_type_subr, /* 5 */ - lrecord_type_cons, /* 6 */ - lrecord_type_vector, - lrecord_type_string, + lrecord_type_symbol, /* 4 */ + lrecord_type_subr, /* 5 */ + lrecord_type_cons, /* 6 */ + lrecord_type_vector, /* 7 */ + lrecord_type_string, /* 8 */ +#ifndef MC_ALLOC lrecord_type_lcrecord_list, - lrecord_type_compiled_function, - lrecord_type_weak_list, - lrecord_type_bit_vector, - lrecord_type_float, - lrecord_type_hash_table, - lrecord_type_lstream, - lrecord_type_process, - lrecord_type_charset, - lrecord_type_coding_system, - lrecord_type_char_table, - lrecord_type_char_table_entry, - lrecord_type_range_table, - lrecord_type_opaque, - lrecord_type_opaque_ptr, - lrecord_type_buffer, - lrecord_type_extent, - lrecord_type_extent_info, - lrecord_type_extent_auxiliary, - lrecord_type_marker, - lrecord_type_event, -#ifdef EVENT_DATA_AS_OBJECTS +#endif /* not MC_ALLOC */ + lrecord_type_compiled_function, /* 9 */ + lrecord_type_weak_list, /* 10 */ + lrecord_type_bit_vector, /* 11 */ + lrecord_type_float, /* 12 */ + lrecord_type_hash_table, /* 13 */ + lrecord_type_lstream, /* 14 */ + lrecord_type_process, /* 15 */ + lrecord_type_charset, /* 16 */ + lrecord_type_coding_system, /* 17 */ + lrecord_type_char_table, /* 18 */ + lrecord_type_char_table_entry, /* 19 */ + lrecord_type_range_table, /* 20 */ + lrecord_type_opaque, /* 21 */ + lrecord_type_opaque_ptr, /* 22 */ + lrecord_type_buffer, /* 23 */ + lrecord_type_extent, /* 24 */ + lrecord_type_extent_info, /* 25 */ + lrecord_type_extent_auxiliary, /* 26 */ + lrecord_type_marker, /* 27 */ + lrecord_type_event, /* 28 */ +#ifdef EVENT_DATA_AS_OBJECTS /* not defined */ lrecord_type_key_data, lrecord_type_button_data, lrecord_type_motion_data, ＠＠ -184,45 +233,47 ＠＠ lrecord_type_magic_eval_data, lrecord_type_magic_data, #endif /* EVENT_DATA_AS_OBJECTS */ - lrecord_type_keymap, - lrecord_type_command_builder, - lrecord_type_timeout, - lrecord_type_specifier, - lrecord_type_console, - lrecord_type_device, - lrecord_type_frame, - lrecord_type_window, - lrecord_type_window_mirror, - lrecord_type_window_configuration, - lrecord_type_gui_item, - lrecord_type_popup_data, - lrecord_type_toolbar_button, - lrecord_type_scrollbar_instance, - lrecord_type_color_instance, - lrecord_type_font_instance, - lrecord_type_image_instance, - lrecord_type_glyph, - lrecord_type_face, - lrecord_type_database, - lrecord_type_tooltalk_message, - lrecord_type_tooltalk_pattern, - lrecord_type_ldap, - lrecord_type_pgconn, - lrecord_type_pgresult, - lrecord_type_devmode, - lrecord_type_mswindows_dialog_id, - lrecord_type_case_table, - lrecord_type_emacs_ffi, - lrecord_type_emacs_gtk_object, - lrecord_type_emacs_gtk_boxed, - lrecord_type_weak_box, - lrecord_type_ephemeron, - lrecord_type_bignum, - lrecord_type_ratio, - lrecord_type_bigfloat, + lrecord_type_keymap, /* 29 */ + lrecord_type_command_builder, /* 30 */ + lrecord_type_timeout, /* 31 */ + lrecord_type_specifier, /* 32 */ + lrecord_type_console, /* 33 */ + lrecord_type_device, /* 34 */ + lrecord_type_frame, /* 35 */ + lrecord_type_window, /* 36 */ + lrecord_type_window_mirror, /* 37 */ + lrecord_type_window_configuration, /* 38 */ + lrecord_type_gui_item, /* 39 */ + lrecord_type_popup_data, /* 40 */ + lrecord_type_toolbar_button, /* 41 */ + lrecord_type_scrollbar_instance, /* 42 */ + lrecord_type_color_instance, /* 43 */ + lrecord_type_font_instance, /* 44 */ + lrecord_type_image_instance, /* 45 */ + lrecord_type_glyph, /* 46 */ + lrecord_type_face, /* 47 */ + lrecord_type_database, /* 48 */ + lrecord_type_tooltalk_message, /* 49 */ + lrecord_type_tooltalk_pattern, /* 50 */ + lrecord_type_ldap, /* 51 */ + lrecord_type_pgconn, /* 52 */ + lrecord_type_pgresult, /* 53 */ + lrecord_type_devmode, /* 54 */ + lrecord_type_mswindows_dialog_id, /* 55 */ + lrecord_type_case_table, /* 56 */ + lrecord_type_emacs_ffi, /* 57 */ + lrecord_type_emacs_gtk_object, /* 58 */ + lrecord_type_emacs_gtk_boxed, /* 59 */ + lrecord_type_weak_box, /* 60 */ + lrecord_type_ephemeron, /* 61 */ + lrecord_type_bignum, /* 62 */ + lrecord_type_ratio, /* 63 */ + lrecord_type_bigfloat, /* 64 */ +#ifndef MC_ALLOC lrecord_type_free, /* only used for "free" lrecords */ lrecord_type_undefined, /* only used for debugging */ - lrecord_type_last_built_in_type /* must be last */ +#endif /* not MC_ALLOC */ + lrecord_type_last_built_in_type /* 65 */ /* must be last */ }; extern MODULE_API int lrecord_type_count; ＠＠ -289,18 +340,24 ＠＠ int (*remprop) (Lisp_Object obj, Lisp_Object prop); Lisp_Object (*plist) (Lisp_Object obj); +#ifdef MC_ALLOC + /* Only one of `static_size' and `size_in_bytes_method' is non-0. */ +#else /* not MC_ALLOC */ /* Only one of `static_size' and `size_in_bytes_method' is non-0. If both are 0, this type is not instantiable by basic_alloc_lcrecord(). */ +#endif /* not MC_ALLOC */ Bytecount static_size; Bytecount (*size_in_bytes_method) (const void *header); /* The (constant) index into lrecord_implementations_table */ enum lrecord_type lrecord_type_index; +#ifndef MC_ALLOC /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e. one that does not have an lcrecord_header at the front and which is (usually) allocated in frob blocks. */ unsigned int basic_p :1; +#endif /* not MC_ALLOC */ }; /* All the built-in lisp object types are enumerated in `enum lrecord_type'. ＠＠ -317,6 +374,76 ＠＠ extern int gc_in_progress; +#ifdef MC_ALLOC +#include "mc-alloc.h" +#endif /* MC_ALLOC */ + +#ifdef MC_ALLOC_TYPE_STATS +void init_lrecord_stats (void); +void inc_lrecord_stats (Bytecount size, const struct lrecord_header *h); +void dec_lrecord_stats (Bytecount size_including_overhead, + const struct lrecord_header *h); +#endif /* MC_ALLOC_TYPE_STATS */ + +#ifdef MC_ALLOC +/* Tell mc-alloc how to call a finalizer. */ +#define MC_ALLOC_CALL_FINALIZER(ptr) \ +{ \ + Lisp_Object MCACF_obj = wrap_pointer_1 (ptr); \ + struct lrecord_header *MCACF_lheader = XRECORD_LHEADER (MCACF_obj); \ + if (XRECORD_LHEADER (MCACF_obj) && LRECORDP (MCACF_obj) \ + && !LRECORD_FREE_P (MCACF_lheader) ) \ + { \ + const struct lrecord_implementation *MCACF_implementation \ + = LHEADER_IMPLEMENTATION (MCACF_lheader); \ + if (MCACF_implementation && MCACF_implementation->finalizer) \ + MCACF_implementation->finalizer (ptr, 0); \ + } \ +} while (0) + +/* Tell mc-alloc how to call a finalizer for disksave. */ +#define MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE(ptr) \ +{ \ + Lisp_Object MCACF_obj = wrap_pointer_1 (ptr); \ + struct lrecord_header *MCACF_lheader = XRECORD_LHEADER (MCACF_obj); \ + if (XRECORD_LHEADER (MCACF_obj) && LRECORDP (MCACF_obj) \ + && !LRECORD_FREE_P (MCACF_lheader) ) \ + { \ + const struct lrecord_implementation *MCACF_implementation \ + = LHEADER_IMPLEMENTATION (MCACF_lheader); \ + if (MCACF_implementation && MCACF_implementation->finalizer) \ + MCACF_implementation->finalizer (ptr, 1); \ + } \ +} while (0) + +#define LRECORD_FREE_P(ptr) \ +(((struct lrecord_header *) ptr)->free) + +#define MARK_LRECORD_AS_FREE(ptr) \ +((void) (((struct lrecord_header *) ptr)->free = 1)) + +#define MARK_LRECORD_AS_NOT_FREE(ptr) \ +((void) (((struct lrecord_header *) ptr)->free = 0)) + +#define MARKED_RECORD_P(obj) MARKED_P (obj) +#define MARKED_RECORD_HEADER_P(lheader) MARKED_P (lheader) +#define MARK_RECORD_HEADER(lheader) MARK (lheader) +#define UNMARK_RECORD_HEADER(lheader) UNMARK (lheader) + +#define LISP_READONLY_RECORD_HEADER_P(lheader) ((lheader)->lisp_readonly) +#define SET_LISP_READONLY_RECORD_HEADER(lheader) \ + ((void) ((lheader)->lisp_readonly = 1)) +#define MARK_LRECORD_AS_LISP_READONLY(ptr) \ +((void) (((struct lrecord_header *) ptr)->lisp_readonly = 1)) + +#else /* not MC_ALLOC */ + +#define LRECORD_FREE_P(ptr) \ +(((struct lrecord_header *) ptr)->type == lrecord_type_free) + +#define MARK_LRECORD_AS_FREE(ptr) \ +((void) (((struct lrecord_header *) ptr)->type = lrecord_type_free)) + #define MARKED_RECORD_P(obj) (XRECORD_LHEADER (obj)->mark) #define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark) #define MARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 1)) ＠＠ -332,6 +459,7 ＠＠ } while (0) #define SET_LISP_READONLY_RECORD_HEADER(lheader) \ ((void) ((lheader)->lisp_readonly = 1)) +#endif /* not MC_ALLOC */ #ifdef USE_KKCC #define RECORD_DESCRIPTION(lheader) lrecord_memory_descriptions[(lheader)->type] ＠＠ -531,7 +659,11 ＠＠ struct Lisp_Hash_Table { +#ifdef MC_ALLOC + struct lrecord_header header; +#else struct lcrecord_header header; +#endif Elemcount size; Elemcount count; Elemcount rehash_count; ＠＠ -596,7 +728,11 ＠＠ struct Lisp_Specifier { +#ifdef MC_ALLOC + struct lrecord_header header; +#else struct lcrecord_header header; +#endif struct specifier_methods *methods; ... ＠＠ -838,12 +974,14 ＠＠ XD_FLAG_NO_PDUMP = 2, /* Indicates that this is a "default" entry in a union map. */ XD_FLAG_UNION_DEFAULT_ENTRY = 4, +#ifndef MC_ALLOC /* Indicates that this is a free Lisp object we're marking. Only relevant for ERROR_CHECK_GC. This occurs when we're marking lcrecord-lists, where the objects have had their type changed to lrecord_type_free and also have had their free bit set, but we mark them as normal. */ XD_FLAG_FREE_LISP_OBJECT = 8 +#endif /* not MC_ALLOC */ #if 0 , /* Suggestions for other possible flags: */ ＠＠ -962,12 +1100,21 ＠＠ #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) +#ifdef MC_ALLOC +#define MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ +DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ +const struct lrecord_implementation lrecord_##c_name = \ + { name, dumpable, marker, printer, nuker, equal, hash, desc, \ + getprop, putprop, remprop, plist, size, sizer, \ + lrecord_type_##c_name } +#else /* not MC_ALLOC */ #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ 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 } +#endif /* not MC_ALLOC */ #define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) ＠＠ -981,6 +1128,15 ＠＠ #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) +#ifdef MC_ALLOC +#define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ +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 } +#else /* not MC_ALLOC */ #define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ int lrecord_type_##c_name; \ ＠＠ -988,6 +1144,7 ＠＠ { name, dumpable, marker, printer, nuker, equal, hash, desc, \ getprop, putprop, remprop, plist, size, sizer, \ lrecord_type_last_built_in_type, basic_p } +#endif /* not MC_ALLOC */ #ifdef USE_KKCC extern MODULE_API const struct memory_description *lrecord_memory_descriptions[]; ＠＠ -1049,7 +1206,11 ＠＠ 1. Declare the struct for your object in a header file somewhere. Remember that it must begin with +#ifdef MC_ALLOC + struct lrecord_header header; +#else struct lcrecord_header header; +#endif 2. Put the "standard junk" (DECLARE_RECORD()/XFOO/etc.) below the struct definition -- see below. ＠＠ -1083,7 +1244,11 ＠＠ struct toolbar_button { +#ifdef MC_ALLOC + struct lrecord_header header; +#else struct lcrecord_header header; +#endif Lisp_Object next; Lisp_Object frame; ＠＠ -1342,6 +1507,7 ＠＠ dead_wrong_type_argument (predicate, x); \ } while (0) +#ifndef MC_ALLOC /*-------------------------- lcrecord-list -----------------------------*/ struct lcrecord_list ＠＠ -1454,6 +1620,7 ＠＠ const struct lrecord_implementation *); #define alloc_lcrecord_type(type, lrecord_implementation) \ ((type *) alloc_automanaged_lcrecord (sizeof (type), lrecord_implementation)) + void free_lcrecord (Lisp_Object rec); ＠＠ -1473,6 +1640,55 ＠＠ #define zero_lcrecord(lcr) zero_sized_lcrecord (lcr, sizeof (*(lcr))) +#else /* MC_ALLOC */ + +/* How to allocate a lrecord: + + - If the size of the lrecord is fix, say it equals its size of its + struct, then use alloc_lrecord_type. + + - If the size varies, i.e. it is not equal to the size of its + struct, use alloc_lrecord and specify the amount of storage you + need for the object. + + - Some lrecords, which are used totally internally, use the + noseeum-* functions for the reason of debugging. + + - To free a Lisp_Object manually, use free_lrecord. */ + +void *alloc_lrecord (Bytecount size, + const struct lrecord_implementation *); + +#define alloc_lrecord_type(type, lrecord_implementation) \ + ((type *) alloc_lrecord (sizeof (type), lrecord_implementation)) + +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)) + +void free_lrecord (Lisp_Object rec); + + +/* Copy the data from one lrecord structure into another, but don't + overwrite the header information. */ + +#define copy_sized_lrecord(dst, src, size) \ + memcpy ((char *) (dst) + sizeof (struct lrecord_header), \ + (char *) (src) + sizeof (struct lrecord_header), \ + (size) - sizeof (struct lrecord_header)) + +#define copy_lrecord(dst, src) copy_sized_lrecord (dst, src, sizeof (*(dst))) + +#define zero_sized_lrecord(lcr, size) \ + memset ((char *) (lcr) + sizeof (struct lrecord_header), 0, \ + (size) - sizeof (struct lrecord_header)) + +#define zero_lrecord(lcr) zero_sized_lrecord (lcr, sizeof (*(lcr))) + +#endif /* MC_ALLOC */ + DECLARE_INLINE_HEADER ( Bytecount detagged_lisp_object_size (const struct lrecord_header *h) ＠＠ -1584,8 +1800,12 ＠＠ #ifdef PDUMP #include "dumper.h" +#ifdef MC_ALLOC +#define DUMPEDP(adr) 0 +#else /* not MC_ALLOC */ #define DUMPEDP(adr) ((((Rawbyte *) (adr)) < pdump_end) && \ (((Rawbyte *) (adr)) >= pdump_start)) +#endif /* not MC_ALLOC */ #else #define DUMPEDP(adr) 0 #endif diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/lstream.c mc-xemacs-21.5/src/lstream.c --- xemacs-21.5/src/lstream.c 2005-03-03 00:40:59.000000000 +0100 +++ mc-xemacs-21.5/src/lstream.c 2005-02-03 22:02:58.000000000 +0100 ＠＠ -180,9 +180,11 ＠＠ } } +#ifndef MC_ALLOC static const Lstream_implementation *lstream_types[32]; static Lisp_Object Vlstream_free_list[32]; static int lstream_type_count; +#endif /* not MC_ALLOC */ /* Allocate and return a new Lstream. This function is not really meant to be called directly; rather, each stream type should ＠＠ -194,6 +196,11 ＠＠ Lstream_new (const Lstream_implementation *imp, const char *mode) { Lstream *p; +#ifdef MC_ALLOC + p = XLSTREAM (wrap_pointer_1 + (alloc_lrecord (aligned_sizeof_lstream (imp->size), + &lrecord_lstream))); +#else /* not MC_ALLOC */ int i; for (i = 0; i < lstream_type_count; i++) ＠＠ -213,6 +220,7 ＠＠ } p = XLSTREAM (alloc_managed_lcrecord (Vlstream_free_list[i])); +#endif /* not MC_ALLOC */ /* Zero it out, except the header. */ memset ((char *) p + sizeof (p->header), '\0', aligned_sizeof_lstream (imp->size) - sizeof (p->header)); ＠＠ -288,9 +296,14 ＠＠ void Lstream_delete (Lstream *lstr) { +#ifndef MC_ALLOC int i; +#endif /* not MC_ALLOC */ Lisp_Object val = wrap_lstream (lstr); +#ifdef MC_ALLOC + free_lrecord (val); +#else /* not MC_ALLOC */ for (i = 0; i < lstream_type_count; i++) { if (lstream_types[i] == lstr->imp) ＠＠ -301,6 +314,7 ＠＠ } ABORT (); +#endif /* not MC_ALLOC */ } #define Lstream_internal_error(reason, lstr) \ ＠＠ -1851,6 +1865,7 ＠＠ LSTREAM_HAS_METHOD (lisp_buffer, marker); } +#ifndef MC_ALLOC void reinit_vars_of_lstream (void) { ＠＠ -1862,6 +1877,7 ＠＠ staticpro_nodump (&Vlstream_free_list[i]); } } +#endif /* not MC_ALLOC */ void vars_of_lstream (void) diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/lstream.h mc-xemacs-21.5/src/lstream.h --- xemacs-21.5/src/lstream.h 2005-03-03 00:41:00.000000000 +0100 +++ mc-xemacs-21.5/src/lstream.h 2005-02-01 22:58:28.000000000 +0100 ＠＠ -230,7 +230,11 ＠＠ struct lstream { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ const Lstream_implementation *imp; /* methods for this stream */ Lstream_buffering buffering; /* type of buffering in use */ Bytecount buffering_size; /* number of bytes buffered */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/Makefile.in.in mc-xemacs-21.5/src/Makefile.in.in --- xemacs-21.5/src/Makefile.in.in 2005-03-11 02:43:08.000000000 +0100 +++ mc-xemacs-21.5/src/Makefile.in.in 2005-03-19 03:14:24.000000000 +0100 ＠＠ -251,6 +251,10 ＠＠ xemacs_res.o #endif +#ifdef MC_ALLOC +mc_alloc_objs=mc-alloc.o +#endif + ## lastfile must follow all files whose initialized data areas should ## be dumped as pure by dump-emacs. ＠＠ -274,6 +278,7 ＠＠ gutter.o\ hash.o imgproc.o indent.o insdel.o intl.o\ keymap.o $(RTC_patch_objs) line-number.o $(ldap_objs) lread.o lstream.o\ + $(mc_alloc_objs) \ macros.o marker.o md5.o minibuf.o $(mswindows_objs) $(mswindows_gui_objs)\ $(mule_objs) $(mule_canna_objs) $(mule_wnn_objs) $(number_objs) objects.o\ opaque.o $(postgresql_objs) print.o process.o $(process_objs) $(profile_objs)\ ＠＠ -418,7 +423,7 ＠＠ DUMP_TARGET = $(PROGNAME).dmp RAW_EXE = $(PROGNAME) DUMP_ID = dump-id.o -#ifndef WIN32_NATIVE +#if !defined(WIN32_NATIVE) && defined(DUMP_IN_EXEC) DUMP_TARGET = $(PROGNAME) #ifndef CYGWIN RAW_EXE = temacs ＠＠ -545,7 +550,7 ＠＠ ## (2) Link the XEmacs executable -#if !defined(PDUMP) || defined(WIN32_NATIVE) +#if !defined(PDUMP) || !defined(DUMP_IN_EXEC) || defined(WIN32_NATIVE) $(RAW_EXE): $(link_deps) $(DUMP_ID) $(LD) $(start_flags) $(ldflags) -o $＠ $(start_files) $(objs) $(otherobjs) $(DUMP_ID) $(LIBES) #else ＠＠ -599,7 +604,7 ＠＠＠$(RM) $＠ $(dump_temacs) #endif -#if defined(PDUMP) && !defined(WIN32_NATIVE) +#if defined(PDUMP) && defined(DUMP_IN_EXEC) && !defined(WIN32_NATIVE) if test -f dump-size; then \ $(LIB_SRC)/insert-data-in-exec $(RAW_EXE) $(DUMP_TARGET).dmp $(DUMP_TARGET) `$(DO_TEMACS) -si`; \ ret=$$? ; \ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/marker.c mc-xemacs-21.5/src/marker.c --- xemacs-21.5/src/marker.c 2005-03-03 00:41:00.000000000 +0100 +++ mc-xemacs-21.5/src/marker.c 2005-03-29 22:06:41.000000000 +0200 ＠＠ -104,11 +104,30 ＠＠ { XD_END } }; +#ifdef MC_ALLOC +static void +finalize_marker (void *header, int for_disksave) +{ + if (!for_disksave) + { + 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); +#else /* not MC_ALLOC */ DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, 1, /*dumpable-flag*/ mark_marker, print_marker, 0, marker_equal, marker_hash, marker_description, Lisp_Marker); +#endif /* not MC_ALLOC */ /* Operations on markers. */ ＠＠ -493,7 +512,11 ＠＠ for (m = BUF_MARKERS (b); m; m = m->next) total += sizeof (Lisp_Marker); ovstats->was_requested += total; +#ifdef MC_ALLOC + overhead = mc_alloced_storage_size (total, 0); +#else /* not MC_ALLOC */ overhead = fixed_type_block_overhead (total); +#endif /* not MC_ALLOC */ /* #### claiming this is all malloc overhead is not really right, but it has to go somewhere. */ ovstats->malloc_overhead += overhead; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/mc-alloc.c mc-xemacs-21.5/src/mc-alloc.c --- xemacs-21.5/src/mc-alloc.c 1970-01-01 01:00:00.000000000 +0100 +++ mc-xemacs-21.5/src/mc-alloc.c 2005-03-30 02:30:29.000000000 +0200 ＠＠ -0,0 +1,1826 ＠＠ +/* New size-based allocator for XEmacs. + Copyright (C) 2005 Marcus Crestani. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +#include <config.h> +#include "lisp.h" +#include "mc-alloc.h" + + +/*--- configurable values ----------------------------------------------*/ + +/* Valid page sizes are powers of 2. */ +#undef PAGE_SIZE /* for FreeBSD */ +#define PAGE_SIZE 2048 + + +/* Definition of size classes */ + +/* Heap used list constants: In the used heap, it is important to + quickly find a free spot for a new object. Therefore the size + classes of the used heap are defined by the size of the cells on + the pages. The size classes should match common object sizes, to + avoid wasting memory. */ + +/* Minimum object size in bytes. */ +#define USED_LIST_MIN_OBJECT_SIZE 8 + +/* The stepping by which the size classes are increasing (up to upper + threshold). This many bytes are mapped to a single used list: */ +#define USED_LIST_LIN_STEP 4 + +/* The upper threshold should always be set to PAGE_SIZE/2, because if + a object is larger than PAGE_SIZE/2 there is no room for any other + object on this page. Objects this big are kept in the page list of + the multiple pages, since a quick search for free spots is not + needed for this kind of pages (because there are no free spots). + PAGE_SIZES_DIV_2 defines maximum size of a used space list. */ +#define USED_LIST_UPPER_THRESHOLD PAGE_SIZE_DIV_2 + + +/* Unmanaged memory used list constants: Like in the used heap, it is + important to quickly find a free spot for a new object. Therefore + the size classes of the unmanaged heap are defined by the size of + the cells on the pages. The size classes should match common object + sizes, to avoid wasting memory. */ +/* Minimum object size in bytes. */ +#define UNMANAGED_LIST_MIN_OBJECT_SIZE 8 +/* The stepping by which the size classes are increasing (up to upper + threshold). This many bytes are mapped to a single unmanaged list: */ +#define UNMANAGED_LIST_LIN_STEP 4 +/* The upper threshold should always be set to PAGE_SIZE/2, because if + a object is larger than PAGE_SIZE/2 there is no room for any other + object on this page. Objects this big are kept in the page list of + the multiple pages, since a quick search for free spots is not + needed for this kind of pages (because there are no free spots). + PAGE_SIZES defines maximum size of a unmanaged space list. */ +#define UNMANAGED_LIST_UPPER_THRESHOLD PAGE_SIZE_DIV_2 + + +/* Heap free list constants: In the unused heap, the size of + consecutive memory tips the scales. A page is smallest entity which + is asked for. Therefore, the size classes of the unused heap are + defined by the number of consecutive pages. */ +/* Sizes up to this many pages each have their own free list. */ +#define FREE_LIST_LOWER_THRESHOLD 32 +/* The stepping by which the size classes are increasing (up to upper + threshold). FREE_LIST_LIN_STEP number of sizes are mapped to a + single free list for sizes between FREE_LIST_LOWER_THRESHOLD and + FREE_LIST_UPPER_THRESHOLD. */ +#define FREE_LIST_LIN_STEP 8 +/* Sizes of at least this many pages are mapped to a single free + list. Blocks of memory larger than this number are all kept in a + single list, which makes searching this list slow. But objects that + big are really seldom. */ +#define FREE_LIST_UPPER_THRESHOLD 256 + + +/* Maximum number of separately added heap sections. */ +#if BITS_PER_EMACS_INT > 32 +# define MAX_HEAP_SECTS 2048 +#else +# define MAX_HEAP_SECTS 768 +#endif + + +/* Heap growth constants. Heap increases by any number between the + boundaries (unit is PAGE_SIZE). */ +#define MIN_HEAP_INCREASE 32 +#define MAX_HEAP_INCREASE 256 /* not used */ + +/* Every heap growth is calculated like this: + needed_pages + ( HEAP_SIZE / ( PAGE_SIZE * HEAP_GROWTH_DIVISOR )). + So the growth of the heap is influenced by the current size of the + heap, but kept between MIN_HEAP_INCREASE and MAX_HEAP_INCREASE + boundaries. + This reduces the number of heap sectors, the larger the heap grows + the larger are the newly allocated chunks. */ +#define HEAP_GROWTH_DIVISOR 3 + + +/* Zero memory before putting on free lists. */ +#define ZERO_MEM 1 + + + + +/*--- calculations done by macros --------------------------------------*/ + +#ifndef CHAR_BIT /* should be included by limits.h */ +# define CHAR_BIT BITS_PER_CHAR +#endif + +#if PAGE_SIZE == 512 +# define CPP_LOG_PAGE_SIZE 9 +#endif +#if PAGE_SIZE == 1024 +# define CPP_LOG_PAGE_SIZE 10 +#endif +#if PAGE_SIZE == 2048 +# define CPP_LOG_PAGE_SIZE 11 +#endif +#if PAGE_SIZE == 4096 +# define CPP_LOG_PAGE_SIZE 12 +#endif +#if PAGE_SIZE == 8192 +# define CPP_LOG_PAGE_SIZE 13 +#endif +#if PAGE_SIZE == 16384 +# define CPP_LOG_PAGE_SIZE 14 +#endif +#ifndef CPP_LOG_PAGE_SIZE +--> fix PAGE_SIZE +#endif +#undef PAGE_SIZE +#define CPP_PAGE_SIZE (1 << CPP_LOG_PAGE_SIZE) +#define LOG_PAGE_SIZE ((EMACS_INT) CPP_LOG_PAGE_SIZE) +#define PAGE_SIZE ((EMACS_INT) CPP_PAGE_SIZE) +#define PAGE_SIZE_DIV_2 (PAGE_SIZE >> 1) + + +/* NOT USED ANYMORE */ +#ifdef USE_EXPONENTIAL_USED_LIST_GROWTH +/* used heap list logarithms */ +#if USED_LIST_LOWER_THRESHOLD == 8 +# define CPP_LOG_USED_LIST_LOWER_THRESHOLD 3 +#endif +#if USED_LIST_LOWER_THRESHOLD == 16 +# define CPP_LOG_USED_LIST_LOWER_THRESHOLD 4 +#endif +#if USED_LIST_LOWER_THRESHOLD == 32 +# define CPP_LOG_USED_LIST_LOWER_THRESHOLD 5 +#endif +#if USED_LIST_LOWER_THRESHOLD == 64 +# define CPP_LOG_USED_LIST_LOWER_THRESHOLD 6 +#endif +#if USED_LIST_LOWER_THRESHOLD == 128 +# define CPP_LOG_USED_LIST_LOWER_THRESHOLD 7 +#endif +#if USED_LIST_LOWER_THRESHOLD == 256 +# define CPP_LOG_USED_LIST_LOWER_THRESHOLD 8 +#endif +#ifndef CPP_LOG_USED_LIST_LOWER_THRESHOLD +--> fix USED_LIST_LOWER_THRESHOLD +#endif +#define LOG_USED_LIST_LOWER_THRESHOLD CPP_LOG_USED_LIST_LOWER_THRESHOLD +#endif /* USE_EXPONENTIAL_USED_LIST_GROWTH */ + +/* used heap list count */ +#define N_USED_PAGE_LISTS (((USED_LIST_UPPER_THRESHOLD \ + - USED_LIST_MIN_OBJECT_SIZE) \ + / USED_LIST_LIN_STEP) + 1 ) + 1 + +/* unmanaged memory list count */ +#define N_UNMANAGED_PAGE_LISTS (((UNMANAGED_LIST_UPPER_THRESHOLD \ + - UNMANAGED_LIST_MIN_OBJECT_SIZE) \ + / UNMANAGED_LIST_LIN_STEP) + 1 ) + 1 + +/* NOT USED ANYMORE */ +#ifdef USE_EXPONENTIAL_USED_LIST_GROWTH +#define N_USED_PAGE_LISTS_LIN (((USED_LIST_LOWER_THRESHOLD \ + - USED_LIST_MIN_OBJECT_SIZE) \ + / USED_LIST_LIN_STEP) + 1 ) +#define N_USED_PAGE_LISTS_EXP \ + (LOG_PAGE_SIZE - LOG_USED_LIST_LOWER_THRESHOLD) + +#define N_USED_PAGE_LISTS \ + (N_USED_PAGE_LISTS_LIN + N_USED_PAGE_LISTS_EXP + 1) +#endif /* USE_EXPONENTIAL_USED_LIST_GROWTH */ + +/* free heap list count */ +#define N_FREE_PAGE_LISTS (((FREE_LIST_UPPER_THRESHOLD \ + - FREE_LIST_LOWER_THRESHOLD) \ + / FREE_LIST_LIN_STEP) \ + + FREE_LIST_LOWER_THRESHOLD) + + +/* Constants for heap address to page header mapping. */ +#define LOG_LEVEL2_SIZE 10 +#define LEVEL2_SIZE (1 << LOG_LEVEL2_SIZE) +#if BITS_PER_EMACS_INT > 32 +# define USE_HASH_TABLE 1 +# define LOG_LEVEL1_SIZE 11 +#else +# define LOG_LEVEL1_SIZE \ + (BITS_PER_EMACS_INT - LOG_LEVEL2_SIZE - LOG_PAGE_SIZE) +#endif +#define LEVEL1_SIZE (1 << LOG_LEVEL1_SIZE) + +#ifdef USE_HASH_TABLE +# define HASH(hi) ((hi) & (LEVEL1_SIZE - 1)) +# define L1_INDEX(p) HASH ((EMACS_INT) p >> (LOG_LEVEL2_SIZE + LOG_PAGE_SIZE)) +#else +# define L1_INDEX(p) ((EMACS_INT) p >> (LOG_LEVEL2_SIZE + LOG_PAGE_SIZE)) +#endif +#define L2_INDEX(p) (((EMACS_INT) p >> LOG_PAGE_SIZE) & (LEVEL2_SIZE - 1)) + + + + +/*--- structs and typedefs ---------------------------------------------*/ + +/* Links the free lists (mark_bit_free_list, page_header_free_list, + cell free list). */ +typedef struct free_link +{ + struct lrecord_header lheader; + struct free_link *next_free; +} free_link; + + +/* Header for pages. They are hold in a doubly linked list. */ +typedef struct page_header +{ + struct page_header *next; /* next page_header */ + struct page_header *prev; /* previous page_header */ + /* Field plh holds pointer to the according header of the page list.*/ + struct page_list_header *plh; /* page list header */ + free_link *free_list; /* links free cells on page */ + EMACS_INT n_pages; /* number of pages */ + EMACS_INT cell_size; /* size of cells on page */ + EMACS_INT cells_on_page; /* total number of cells on page */ + EMACS_INT cells_used; /* number of used cells on page */ + /* If the number of objects on page is bigger than BITS_PER_EMACS_INT, + the mark bits are put in an extra memory area. Then the field + mark_bits holds the pointer to this area. Is the number of + objects smaller than BITS_PER_EMACS_INT, the mark bits are held in the + mark_bit EMACS_INT directly, without an additional indirection. */ + char *mark_bits; /* pointer to mark bits */ + void *heap_space; /* pointer to heap, where objects + are stored */ +} page_header; + + +/* Different list types. */ +enum list_type_enum { + USED_LIST, + UNMANAGED_LIST, + FREE_LIST +}; + + +/* Header for page lists. Field list_type holds the type of the list. */ +typedef struct page_list_header +{ + enum list_type_enum list_type; /* the type of the list */ + /* Size holds the size of one cell (in bytes) in a used heap list, or the + size of the heap sector (in number of pages). */ + size_t size; /* size of one cell / heap sector */ + page_header *first; /* first of page_header list */ + page_header *last; /* last of page_header list */ + /* If the number of objects on page is bigger than + BITS_PER_EMACS_INT, the mark bits are put in an extra memory + area, which is linked in this free list, if not used. Is the + number of objects smaller than BITS_PER_EMACS_INT, the mark bits + are hold in the mark bit EMACS_INT directly, without an + additional indirection. */ + free_link *mark_bit_free_list; + +#ifdef MEMORY_USAGE_STATS + EMACS_INT page_count; /* number if pages in list */ + EMACS_INT used_cells; /* number of objects in list */ + EMACS_INT used_space; /* used space */ + EMACS_INT total_cells; /* number of available cells */ + EMACS_INT total_space; /* available space */ +#endif +} page_list_header; + + +/* The heap sectors are stored with their real start pointer and their + real size. Not aligned to PAGE_SIZE. Needed for freeing heap sectors. */ +typedef struct heap_sect { + void *real_start; /* real start pointer (NOT aligned) */ + size_t real_size; /* NOT multiple of PAGE_SIZE */ + void *start; /* aligned start pointer */ + EMACS_INT n_pages; /* multiple of PAGE_SIZE */ +} heap_sect; + + +/* 2nd tree level for mapping of heap addresses to page headers. */ +typedef struct level_2_lookup_tree { + page_header *index[LEVEL2_SIZE]; /* link to page header */ + EMACS_INT key; /* high order address bits */ +#ifdef USE_HASH_TABLE + struct level_2_lookup_tree *hash_link; /* hash chain link */ +#endif +} level_2_lookup_tree; + + + +/*--- global variable definitions --------------------------------------*/ + +/* All global allocator variables are kept in this struct. */ +typedef struct mc_allocator_globals_type { + + /* heap size */ + EMACS_INT heap_size; + + /* list of all separatly allocated chunks of heap */ + heap_sect heap_sections[MAX_HEAP_SECTS]; + EMACS_INT n_heap_sections; + + /* Holds all allocated pages, each object size class in its separate list, + to guarantee fast allocation on partially filled pages. */ + page_list_header used_heap_pages[N_USED_PAGE_LISTS]; + + /* Holds all unmanaged pages. */ + page_list_header unmanaged_heap_pages[N_UNMANAGED_PAGE_LISTS]; + + /* Holds all free pages in the heap. N multiples of PAGE_SIZE are + kept on the Nth free list. Contiguos pages are coalesced. */ + page_list_header free_heap_pages[N_FREE_PAGE_LISTS]; + + /* ptr lookup table */ + level_2_lookup_tree *ptr_lookup_table[LEVEL1_SIZE]; + + /* page header free list */ + free_link *page_header_free_list; + +#ifdef MEMORY_USAGE_STATS + EMACS_INT malloced_bytes; +#endif +} mc_allocator_globals_type; + +mc_allocator_globals_type mc_allocator_globals; + + + + +/*--- macro accessors --------------------------------------------------*/ + +#define USED_HEAP_PAGES(i) \ + ((page_list_header*) &mc_allocator_globals.used_heap_pages[i]) + +#define UNMANAGED_HEAP_PAGES(i) \ + ((page_list_header*) &mc_allocator_globals.unmanaged_heap_pages[i]) + +#define FREE_HEAP_PAGES(i) \ + ((page_list_header*) &mc_allocator_globals.free_heap_pages[i]) + +#define PLH(plh) plh +# define PLH_LIST_TYPE(plh) PLH (plh)->list_type +# define PLH_SIZE(plh) PLH (plh)->size +# define PLH_FIRST(plh) PLH (plh)->first +# define PLH_LAST(plh) PLH (plh)->last +# define PLH_MARK_BIT_FREE_LIST(plh) PLH (plh)->mark_bit_free_list +#ifdef MEMORY_USAGE_STATS +# define PLH_PAGE_COUNT(plh) PLH (plh)->page_count +# define PLH_USED_CELLS(plh) PLH (plh)->used_cells +# define PLH_USED_SPACE(plh) PLH (plh)->used_space +# define PLH_TOTAL_CELLS(plh) PLH (plh)->total_cells +# define PLH_TOTAL_SPACE(plh) PLH (plh)->total_space +#endif + +#define PH(ph) ph +# define PH_NEXT(ph) PH (ph)->next +# define PH_PREV(ph) PH (ph)->prev +# define PH_PLH(ph) PH (ph)->plh +# define PH_FREE_LIST(ph) PH (ph)->free_list +# define PH_N_PAGES(ph) PH (ph)->n_pages +# define PH_CELL_SIZE(ph) PH (ph)->cell_size +# define PH_CELLS_ON_PAGE(ph) PH (ph)->cells_on_page +# define PH_CELLS_USED(ph) PH (ph)->cells_used +# define PH_MARK_BITS(ph) PH (ph)->mark_bits +# define PH_HEAP_SPACE(ph) PH (ph)->heap_space +#define PH_LIST_TYPE(ph) PLH_LIST_TYPE (PH_PLH (ph)) +#define PH_MARK_BIT_FREE_LIST(ph) PLH_MARK_BIT_FREE_LIST (PH_PLH (ph)) + +#define HEAP_SIZE mc_allocator_globals.heap_size + +#ifdef MEMORY_USAGE_STATS +# define MC_MALLOCED_BYTES mc_allocator_globals.malloced_bytes +#endif + +#define HEAP_SECTION(index) mc_allocator_globals.heap_sections[index] +#define N_HEAP_SECTIONS mc_allocator_globals.n_heap_sections + +#define PAGE_HEADER_FREE_LIST mc_allocator_globals.page_header_free_list + +#define NEXT_FREE(free_list) ((free_link*) free_list)->next_free +#define FREE_LIST(free_list) (free_link*) (free_list) + +#define PTR_LOOKUP_TABLE(i) mc_allocator_globals.ptr_lookup_table[i] +#define LEVEL2(l2, i) l2->index[i] +# define LEVEL2_KEY(l2) l2->key +#ifdef USE_HASH_TABLE +# define LEVEL2_HASH_LINK(l2) l2->hash_link +#endif + +#if ZERO_MEM +# define ZERO_HEAP_SPACE(ph) \ + memset (PH_HEAP_SPACE (ph), '\0', PH_N_PAGES (ph) * PAGE_SIZE) +# define ZERO_PAGE_HEADER(ph) memset (ph, '\0', sizeof (page_header)) +#endif + +#define div_PAGE_SIZE(x) (x >> LOG_PAGE_SIZE) +#define mult_PAGE_SIZE(x) (x << LOG_PAGE_SIZE) + +#define BYTES_TO_PAGES(bytes) (div_PAGE_SIZE ((bytes + (PAGE_SIZE - 1)))) + +#define PAGE_SIZE_ALIGNMENT(address) \ + (void *) ((((EMACS_INT) (address)) + PAGE_SIZE) & ~(PAGE_SIZE - 1)) + +#define PH_ON_FREE_LIST_P(ph) \ + (ph && PH_PLH (ph) && (PLH_LIST_TYPE (PH_PLH (ph)) == FREE_LIST)) + +#define PH_ON_USED_LIST_P(ph) \ + (ph && PH_PLH (ph) && (PLH_LIST_TYPE (PH_PLH (ph)) == USED_LIST)) + +#define PH_ON_UNMANAGED_LIST_P(ph) \ + (ph && PH_PLH (ph) && (PLH_LIST_TYPE (PH_PLH (ph)) == UNMANAGED_LIST)) + + + + +/************************************************************************/ +/* MC Allocator */ +/************************************************************************/ + + +/* ###TODO### */ +#if 1 +# define ALLOC_MB_UNMANAGED 1 +#endif + + +/*--- misc functions ---------------------------------------------------*/ + +/* moved here from alloc.c */ +#ifdef ERROR_CHECK_GC +static void +deadbeef_memory (void *ptr, Bytecount size) +{ + UINT_32_BIT *ptr4 = (UINT_32_BIT *) ptr; + Bytecount beefs = size >> 2; + + /* In practice, size will always be a multiple of four. */ + while (beefs--) + (*ptr4++) = 0xDEADBEEF; /* -559038737 base 10 */ +} +#endif /* ERROR_CHECK_GC */ + +/* Visits all pages (page_headers) hooked into the used heap pages + list and executes f with the current page header as + argument. Needed for sweep. */ +static void +visit_all_used_page_headers (void (*f) (page_header *ph)) +{ + int i; + for (i = 0; i < N_USED_PAGE_LISTS; i++) + if (PLH_FIRST (USED_HEAP_PAGES (i))) + { + page_header *ph = PLH_FIRST (USED_HEAP_PAGES (i)); + while (PH_NEXT (ph)) + { + page_header *next = PH_NEXT (ph); /* in case f removes the page */ + f (ph); + ph = next; + } + f (ph); + } +} + + + + +/*--- mapping of heap addresses to page headers and mark bits ----------*/ + +/* Sets a heap pointer and page header pair into the lookup table. */ +static void +set_lookup_table (void *ptr, page_header *ph) +{ + int l1_index = L1_INDEX (ptr); + level_2_lookup_tree *l2 = PTR_LOOKUP_TABLE (l1_index); +#ifdef USE_HASH_TABLE + while ((l2) && (LEVEL2_KEY (l2) != l1_index)) + l2 = LEVEL2_HASH_LINK (l2); +#endif + if (!l2) + { + l2 = (level_2_lookup_tree*) + xmalloc_and_zero (sizeof (level_2_lookup_tree)); +#ifdef MEMORY_USAGE_STATS + MC_MALLOCED_BYTES += + malloced_storage_size (0, sizeof (level_2_lookup_tree), 0); +#endif + memset (l2, 0, sizeof (level_2_lookup_tree)); +#ifdef USE_HASH_TABLE + LEVEL2_HASH_LINK (l2) = PTR_LOOKUP_TABLE (l1_index); +#endif + PTR_LOOKUP_TABLE (l1_index) = l2; + LEVEL2_KEY (l2) = l1_index; + } + LEVEL2 (l2, L2_INDEX (ptr)) = ph; +} + + +#ifdef UNSET_LOOKUP_TABLE +/* Set the lookup table to 0 for given heap address. */ +static void +unset_lookup_table (void *ptr) +{ + int l1_index = L1_INDEX (ptr); + level_2_lookup_tree *l2 = PTR_LOOKUP_TABLE (l1_index); +#ifdef USE_HASH_TABLE + while ((l2) && (LEVEL2_KEY (l2) != l1_index)) + l2 = LEVEL2_HASH_LINK (l2); +#endif + if (l2) { + LEVEL2 (l2, L2_INDEX (ptr)) = 0; + } +} +#endif + +/* Returns the page header of a given heap address, or 0 if not in table. + For internal use, no error checking. */ +static page_header * +get_page_header_internal (void *ptr) +{ + int l1_index = L1_INDEX (ptr); + level_2_lookup_tree *l2 = PTR_LOOKUP_TABLE (l1_index); +#ifdef USE_HASH_TABLE + while ((l2) && (LEVEL2_KEY (l2) != l1_index)) + l2 = LEVEL2_HASH_LINK (l2); +#endif + if (!l2) + return 0; + return LEVEL2 (l2, L2_INDEX (ptr)); +} + +/* Returns the page header of a given heap address, or 0 if not in table. */ +static page_header * +get_page_header (void *ptr) +{ + int l1_index = L1_INDEX (ptr); + level_2_lookup_tree *l2 = PTR_LOOKUP_TABLE (l1_index); +#ifdef USE_HASH_TABLE + while ((l2) && (LEVEL2_KEY (l2) != l1_index)) + l2 = LEVEL2_HASH_LINK (l2); +#endif + assert (l2 && LEVEL2 (l2, L2_INDEX (ptr))); + return LEVEL2 (l2, L2_INDEX (ptr)); +} + + +/* Returns the mark bit index of a given heap address. */ +static EMACS_INT +get_mark_bit_index (void *ptr, page_header *ph) +{ + EMACS_INT cell_size = PH_CELL_SIZE (ph); + if (cell_size) + return (((EMACS_INT) ptr - (EMACS_INT)(PH_HEAP_SPACE (ph))) / cell_size); + else /* only one object on page */ + return 0; +} + + +/* Adds addresses of pages to lookup table. */ +static void +add_pages_to_lookup_table (page_header *ph, EMACS_INT n_pages) +{ + char *p = (char*) PH_HEAP_SPACE (ph); + EMACS_INT end_of_section = (EMACS_INT) p + (PAGE_SIZE * n_pages); + for (p = (char*) PH_HEAP_SPACE (ph); + (EMACS_INT) p < end_of_section; p += PAGE_SIZE) + set_lookup_table (p, ph); +} + + +/* Initializes lookup table. */ +static void +init_lookup_table (void) +{ + int i; + for (i = 0; i < LEVEL1_SIZE; i++) + PTR_LOOKUP_TABLE (i) = 0; +} + + + + +/*--- mark bits --------------------------------------------------------*/ + +/* Number of mark bits: minimum 1, maximum 8. */ +#define N_MARK_BITS 1 + +/*--- bit operations --- */ + +/* Allocates a bit array of length bits. */ +static char * +alloc_bit_array(size_t bits) +{ +#ifdef ALLOC_MB_UNMANAGED + size_t size = ((bits + CHAR_BIT - 1) / CHAR_BIT) * sizeof(char); + if (size < sizeof (free_link)) size = sizeof (free_link); + return (char *) mc_alloc_unmanaged (size); +#else /* not ALLOC_MB_UNMANAGED */ + size_t size = ((bits + CHAR_BIT - 1) / CHAR_BIT) * sizeof(char); + char *bit_array; + if (size < sizeof (free_link)) size = sizeof (free_link); + bit_array = (char*) xmalloc_and_zero (size); +#ifdef MEMORY_USAGE_STATS + MC_MALLOCED_BYTES += malloced_storage_size (0, size, 0); +#endif + return bit_array; +#endif /* not ALLOC_MB_UNMANAGED */ +} + + +/* Returns the bit value at pos. */ +static EMACS_INT +get_bit (char *bit_array, EMACS_INT pos) +{ +#if N_MARK_BITS > 1 + EMACS_INT result = 0; + EMACS_INT i; +#endif + bit_array += pos / CHAR_BIT; +#if N_MARK_BITS > 1 + for (i = 0; i < N_MARK_BITS; i++) + result |= (*bit_array & (1 << ((pos + i) % CHAR_BIT))); + return result >> pos; +#else + return (*bit_array & (1 << (pos % CHAR_BIT))) != 0; +#endif +} + + +/* Bit_Arrays bit at pos to val. */ +static void +set_bit(char *bit_array, EMACS_INT pos, EMACS_INT val) +{ +#if N_MARK_BITS > 1 + EMACS_INT result = 0; + EMACS_INT i; +#endif + bit_array += pos / CHAR_BIT; +#if N_MARK_BITS > 1 + for (i = 0; i < N_MARK_BITS; i++) + if ((val >> i) & 1) + *bit_array |= 1 << ((pos + i) % CHAR_BIT); + else + *bit_array &= ~(1 << ((pos + i) % CHAR_BIT)); +#else + if (val) + *bit_array |= 1 << (pos % CHAR_BIT); + else + *bit_array &= ~(1 << (pos % CHAR_BIT)); +#endif +} + + +/*--- mark bit functions ---*/ +#define USE_PNTR_MARK_BITS(ph) (PH_CELLS_ON_PAGE (ph) > BITS_PER_EMACS_INT) +#define USE_WORD_MARK_BITS(ph) (PH_CELLS_ON_PAGE (ph) <= BITS_PER_EMACS_INT) + +#define GET_BIT_WORD(b, p) get_bit ((char*) &b, p) +#define GET_BIT_PNTR(b, p) get_bit (b, p) + +#define SET_BIT_WORD(b, p, v) set_bit ((char*) &b, p, v) +#define SET_BIT_PNTR(b, p, v) set_bit (b, p, v) + +#define ZERO_MARK_BITS_WORD(ph) PH_MARK_BITS (ph) = 0 +#define ZERO_MARK_BITS_PNTR(ph) \ +do { \ + memset (PH_MARK_BITS (ph), '\0', \ + (PH_CELLS_ON_PAGE (ph) + CHAR_BIT - 1) \ + / CHAR_BIT * sizeof(char)); \ +} while (0) + +#define GET_BIT(bit, ph, p) \ +do { \ + if (USE_PNTR_MARK_BITS (ph)) \ + bit = GET_BIT_PNTR (PH_MARK_BITS (ph), p); \ + else \ + bit = GET_BIT_WORD (PH_MARK_BITS (ph), p); \ +} while (0) + +#define SET_BIT(ph, p, v) \ +do { \ + if (USE_PNTR_MARK_BITS (ph)) \ + SET_BIT_PNTR (PH_MARK_BITS (ph), p, v); \ + else \ + SET_BIT_WORD (PH_MARK_BITS (ph), p, v); \ +} while (0) + +#define ZERO_MARK_BITS(ph) \ +do { \ + if (USE_PNTR_MARK_BITS (ph)) \ + ZERO_MARK_BITS_PNTR (ph); \ + else \ + ZERO_MARK_BITS_WORD (ph); \ +} while (0) + + +/* Allocates mark-bit space either from a free list or from the OS + for the given page header. */ +static char * +alloc_mark_bits (page_header *ph) +{ + char *result; + if (PH_MARK_BIT_FREE_LIST (ph) == 0) + result = (char*) alloc_bit_array (PH_CELLS_ON_PAGE (ph) * N_MARK_BITS); + else + { + result = (char*) PH_MARK_BIT_FREE_LIST (ph); + PH_MARK_BIT_FREE_LIST (ph) = NEXT_FREE (result); + } + return result; +} + + +/* Frees by maintaining a free list. */ +static void +free_mark_bits (page_header *ph) +{ +#ifdef ALLOC_MB_UNMANAGED + if (PH_MARK_BITS (ph)) + mc_free (PH_MARK_BITS (ph)); +#else /* not ALLOC_MB_UNMANAGED */ + if (PH_MARK_BITS (ph)) { + NEXT_FREE (PH_MARK_BITS (ph)) = PH_MARK_BIT_FREE_LIST (ph); + PH_MARK_BIT_FREE_LIST (ph) = FREE_LIST (PH_MARK_BITS (ph)); + } +#endif /* not ALLOC_MB_UNMANAGED */ +} + + +/* Installs mark bits and zeros bits. */ +static void +install_mark_bits (page_header *ph) +{ + if (USE_PNTR_MARK_BITS (ph)) + { + PH_MARK_BITS (ph) = alloc_mark_bits (ph); + ZERO_MARK_BITS_PNTR (ph); + } + else + ZERO_MARK_BITS_WORD (ph); +} + + +/* Cleans and frees the mark bits of the given page_header. */ +static void +remove_mark_bits (page_header *ph) +{ + if (USE_PNTR_MARK_BITS (ph)) + free_mark_bits (ph); +} + + +/* Zeros all mark bits in given header. */ +static void +zero_mark_bits (page_header *ph) +{ + ZERO_MARK_BITS (ph); +} + + +/* Returns mark bit for given heap pointer. */ +EMACS_INT +get_mark_bit (void *ptr) +{ + EMACS_INT bit = 0; + page_header *ph = get_page_header (ptr); + gc_checking_assert (ph && PH_ON_USED_LIST_P (ph)); + if (ph) + { + GET_BIT (bit, ph, get_mark_bit_index (ptr, ph)); + } + return bit; +} + + +/* Sets mark bit for given heap pointer. */ +void +set_mark_bit (void *ptr, EMACS_INT value) +{ + page_header *ph = get_page_header (ptr); + assert (ph && PH_ON_USED_LIST_P (ph)); + if (ph) + { + SET_BIT (ph, get_mark_bit_index (ptr, ph), value); + } +} + + + + +/*--- page header functions --------------------------------------------*/ + +/* Allocates a page header either from a free list or from the OS. */ +static page_header * +alloc_page_header (void) +{ + page_header *result; + if (PAGE_HEADER_FREE_LIST == 0) + { + result = + (page_header *) xmalloc_and_zero ((EMACS_INT) (sizeof (page_header))); +#ifdef MEMORY_USAGE_STATS + MC_MALLOCED_BYTES += malloced_storage_size (0, sizeof (page_header), 0); +#endif + + } + else + { + result = (page_header*) PAGE_HEADER_FREE_LIST; + PAGE_HEADER_FREE_LIST = NEXT_FREE (result); + } + return result; +} + + +/* Frees given page header by maintaining a free list. */ +static void +free_page_header (page_header *ph) +{ +#if ZERO_MEM + ZERO_PAGE_HEADER (ph); +#endif + NEXT_FREE (ph) = PAGE_HEADER_FREE_LIST; + PAGE_HEADER_FREE_LIST = FREE_LIST (ph); +} + + +/* Adds given page header to given page list header's list. */ +static void +add_page_header_to_plh (page_header *ph, page_list_header *plh) +{ + /* insert at the front of the list */ + PH_PREV (ph) = 0; + PH_NEXT (ph) = PLH_FIRST (plh); + PH_PLH (ph) = plh; + /* if list is not empty, set prev in the first element */ + if (PLH_FIRST (plh)) + PH_PREV (PLH_FIRST (plh)) = ph; + /* one element in list is first and last at the same time */ + PLH_FIRST (plh) = ph; + if (!PLH_LAST (plh)) + PLH_LAST (plh) = ph; + +#ifdef MEMORY_USAGE_STATS + /* bump page count */ + PLH_PAGE_COUNT (plh)++; +#endif + +} + + +/* Removes given page header from given page list header's list. */ +static void +remove_page_header_from_plh (page_header *ph, page_list_header *plh) +{ + if (PLH_FIRST (plh) == ph) + PLH_FIRST (plh) = PH_NEXT (ph); + if (PLH_LAST (plh) == ph) + PLH_LAST (plh) = PH_PREV (ph); + if (PH_NEXT (ph)) + PH_PREV (PH_NEXT (ph)) = PH_PREV (ph); + if (PH_PREV (ph)) + PH_NEXT (PH_PREV (ph)) = PH_NEXT (ph); + +#ifdef MEMORY_USAGE_STATS + /* decrease page count */ + PLH_PAGE_COUNT (plh)--; +#endif +} + + +/* Moves a page header to the front of its the page header list. + This is used during sweep: Pages with some alive objects are moved to + the front. This makes allocation faster, all pages with free slots + can be found at the front of the list. */ +static void +move_page_header_to_front (page_header *ph) +{ + page_list_header *plh = PH_PLH (ph); + /* is page already first? */ + if (ph == PLH_FIRST (plh)) return; + /* remove from list */ + if (PLH_LAST (plh) == ph) + PLH_LAST (plh) = PH_PREV (ph); + if (PH_NEXT (ph)) + PH_PREV (PH_NEXT (ph)) = PH_PREV (ph); + if (PH_PREV (ph)) + PH_NEXT (PH_PREV (ph)) = PH_NEXT (ph); + /* insert at the front */ + PH_NEXT (ph) = PLH_FIRST (plh); + PH_PREV (ph) = 0; + PH_PREV (PH_NEXT (ph)) = ph; + PLH_FIRST (plh) = ph; +} + + + + +/*--- page list functions ----------------------------------------------*/ + +/* Returns the index of the used heap list according to given size. */ +static int +get_used_list_index (size_t size) +{ + if (size <= USED_LIST_MIN_OBJECT_SIZE) + return 0; + if (size <= USED_LIST_UPPER_THRESHOLD) + return ((size - USED_LIST_MIN_OBJECT_SIZE - 1) + / USED_LIST_LIN_STEP) + 1; + return N_USED_PAGE_LISTS - 1; +} + + +/* Returns the size of the used heap list according to given index. */ +static size_t +get_used_list_size_value (int used_index) +{ + if (used_index < N_USED_PAGE_LISTS - 1) + return (used_index * USED_LIST_LIN_STEP) + USED_LIST_MIN_OBJECT_SIZE; + return 0; +} + + +/* Returns the index of the used heap list according to given size. */ +static int +get_unmanaged_list_index (size_t size) +{ + if (size <= UNMANAGED_LIST_MIN_OBJECT_SIZE) + return 0; + if (size <= UNMANAGED_LIST_UPPER_THRESHOLD) + return ((size - UNMANAGED_LIST_MIN_OBJECT_SIZE - 1) + / UNMANAGED_LIST_LIN_STEP) + 1; + return N_UNMANAGED_PAGE_LISTS - 1; +} + + +/* Returns the size of the unmanaged heap list according to given index. */ +static size_t +get_unmanaged_list_size_value (int unmanaged_index) +{ + if (unmanaged_index < N_UNMANAGED_PAGE_LISTS - 1) + return (unmanaged_index * UNMANAGED_LIST_LIN_STEP) + + UNMANAGED_LIST_MIN_OBJECT_SIZE; + return 0; +} + + +/* Returns the index of the free heap list according to given size. */ +static int +get_free_list_index (EMACS_INT n_pages) +{ + if (n_pages == 0) + return 0; + if (n_pages <= FREE_LIST_LOWER_THRESHOLD) + return n_pages - 1; + if (n_pages >= FREE_LIST_UPPER_THRESHOLD - 1) + return N_FREE_PAGE_LISTS - 1; + return ((n_pages - FREE_LIST_LOWER_THRESHOLD - 1) + / FREE_LIST_LIN_STEP) + FREE_LIST_LOWER_THRESHOLD; + +} + + +/* Returns the size in number of pages of the given free list at index. */ +static size_t +get_free_list_size_value (int free_index) +{ + if (free_index < FREE_LIST_LOWER_THRESHOLD) + return free_index + 1; + if (free_index >= N_FREE_PAGE_LISTS) + return FREE_LIST_UPPER_THRESHOLD; + return ((free_index + 1 - FREE_LIST_LOWER_THRESHOLD) + * FREE_LIST_LIN_STEP) + FREE_LIST_LOWER_THRESHOLD; +} + + +#ifdef MEMORY_USAGE_STATS +Bytecount +mc_alloced_storage_size (Bytecount claimed_size, struct overhead_stats *stats) +{ + size_t used_size = + get_used_list_size_value (get_used_list_index (claimed_size)); + if (used_size == 0) + used_size = mult_PAGE_SIZE (BYTES_TO_PAGES (claimed_size)); + + if (stats) + { + stats->was_requested += claimed_size; + stats->malloc_overhead += used_size - claimed_size; + } + + return used_size; +} +#endif /* not MEMORY_USAGE_STATS */ + + + +/*--- free heap functions ----------------------------------------------*/ + +/* Frees a heap section, if the heap_section is completly free */ +static EMACS_INT +free_heap_section (page_header *ph) +{ + int i; + int removed = 0; + for (i = 0; i < N_HEAP_SECTIONS; i++) + if (!removed) + { + if ((PH_HEAP_SPACE (ph) == HEAP_SECTION(i).start) + && (PH_N_PAGES (ph) == HEAP_SECTION(i).n_pages)) + { + xfree_1 (HEAP_SECTION(i).real_start); +#ifdef MEMORY_USAGE_STATS + MC_MALLOCED_BYTES + -= malloced_storage_size (0, HEAP_SECTION(i).real_size, 0); +#endif + + HEAP_SIZE -= PH_N_PAGES (ph) * PAGE_SIZE; + + removed = 1; + } + } + else + { + HEAP_SECTION(i-1).real_start = HEAP_SECTION(i).real_start; + HEAP_SECTION(i-1).real_size = HEAP_SECTION(i).real_size; + HEAP_SECTION(i-1).start = HEAP_SECTION(i).start; + HEAP_SECTION(i-1).n_pages = HEAP_SECTION(i).n_pages; + } + + N_HEAP_SECTIONS = N_HEAP_SECTIONS - removed; + + return removed; +} + +/* Removes page from free list. */ +static void +remove_page_from_free_list (page_header *ph) +{ + remove_page_header_from_plh (ph, PH_PLH (ph)); + PH_PLH (ph) = 0; +} + + +/* Adds page to according free list. */ +static void +add_page_to_free_list (page_header *ph) +{ + PH_PLH (ph) = FREE_HEAP_PAGES (get_free_list_index (PH_N_PAGES (ph))); + add_page_header_to_plh (ph, PH_PLH (ph)); +} + + +/* Merges two adjacent pages. */ +static page_header * +merge_pages (page_header *first_ph, page_header *second_ph) +{ + /* merge */ + PH_N_PAGES (first_ph) += PH_N_PAGES (second_ph); + /* clean up left over page header */ + free_page_header (second_ph); + /* update lookup table */ + add_pages_to_lookup_table (first_ph, PH_N_PAGES (first_ph)); + + return first_ph; +} + + +/* Checks if pages are adjacent, merges them, and adds merged page to + free list */ +static void +merge_into_free_list (page_header *ph) +{ + /* check if you can coalesce adjacent pages */ + page_header *prev_ph = + get_page_header_internal ((void*) (((EMACS_INT) PH_HEAP_SPACE (ph)) + - PAGE_SIZE)); + page_header *succ_ph = + get_page_header_internal ((void*) (((EMACS_INT) PH_HEAP_SPACE (ph)) + + (PH_N_PAGES (ph) * PAGE_SIZE))); + if (PH_ON_FREE_LIST_P (prev_ph)) + { + remove_page_from_free_list (prev_ph); + ph = merge_pages (prev_ph, ph); + } + if (PH_ON_FREE_LIST_P (succ_ph)) + { + remove_page_from_free_list (succ_ph); + ph = merge_pages (ph, succ_ph); + } + /* try to free heap_section, if the section is complete */ + if (!free_heap_section (ph)) + /* else add merged page to free list */ + add_page_to_free_list (ph); +} + + +/* Cuts given page header after n_pages, returns the first (cut) part, and + puts the rest on the free list. */ +static page_header * +split_page (page_header *ph, EMACS_INT n_pages) +{ + page_header *new_ph; + EMACS_INT rem_pages = PH_N_PAGES (ph) - n_pages; + + /* remove the page from the free list if already hooked in */ + if (PH_PLH (ph)) + remove_page_from_free_list (ph); + /* set new number of pages */ + PH_N_PAGES (ph) = n_pages; + /* add new page to lookup table */ + add_pages_to_lookup_table (ph, n_pages); + + if (rem_pages) + { + /* build new page with reminder */ + new_ph = alloc_page_header (); + PH_N_PAGES (new_ph) = rem_pages; + PH_HEAP_SPACE (new_ph) = + (void*) ((EMACS_INT) (PH_HEAP_SPACE (ph)) + (n_pages * PAGE_SIZE)); + /* add new page to lookup table */ + add_pages_to_lookup_table (new_ph, rem_pages); + /* hook the rest into free list */ + add_page_to_free_list (new_ph); + } + return ph; +} + + +/* Expands the heap by given number of pages. */ +static page_header * +expand_heap (EMACS_INT needed_pages) +{ + page_header *ph; + EMACS_INT n_pages; + size_t real_size; + void *real_start; + + /* determine number of pages the heap should grow */ + n_pages = needed_pages + (HEAP_SIZE / (PAGE_SIZE * HEAP_GROWTH_DIVISOR)); + if (n_pages < MIN_HEAP_INCREASE) + n_pages = MIN_HEAP_INCREASE; + + /* get the real values */ + real_size = (n_pages * PAGE_SIZE) + PAGE_SIZE; + real_start = xmalloc_and_zero (real_size); +#ifdef MEMORY_USAGE_STATS + MC_MALLOCED_BYTES += malloced_storage_size (0, real_size, 0); +#endif + + /* maintain heap section count */ + if (N_HEAP_SECTIONS >= MAX_HEAP_SECTS) + { + stderr_out ("Increase number of MAX_HEAP_SECTS"); + ABORT (); + } + HEAP_SECTION(N_HEAP_SECTIONS).real_start = real_start; + HEAP_SECTION(N_HEAP_SECTIONS).real_size = real_size; + HEAP_SECTION(N_HEAP_SECTIONS).start = PAGE_SIZE_ALIGNMENT (real_start); + HEAP_SECTION(N_HEAP_SECTIONS).n_pages = n_pages; + N_HEAP_SECTIONS ++; + + /* get page header */ + ph = alloc_page_header (); + + /* setup page header */ + PH_N_PAGES (ph) = n_pages; + PH_HEAP_SPACE (ph) = PAGE_SIZE_ALIGNMENT (real_start); + assert (((EMACS_INT) (PH_HEAP_SPACE (ph)) % PAGE_SIZE) == 0); + HEAP_SIZE += n_pages * PAGE_SIZE; + + /* this was also done by allocate_lisp_storage */ + if (need_to_check_c_alloca) + xemacs_c_alloca (0); + + /* return needed size, put rest on free list */ + return split_page (ph, needed_pages); +} + + + + +/*--- used heap functions ----------------------------------------------*/ +/* Installs initial free list. */ +static void +install_cell_free_list (page_header *ph) +{ + char *p; + int i; + EMACS_INT cell_size = PH_CELL_SIZE (ph); + /* write initial free list if cell_size is < PAGE_SIZE */ + p = (char *) PH_HEAP_SPACE (ph); + for (i = 0; i < PH_CELLS_ON_PAGE (ph) - 1; i++) + { +#ifdef ERROR_CHECK_GC + assert (!LRECORD_FREE_P (p)); + MARK_LRECORD_AS_FREE (p); +#endif + NEXT_FREE (p) = FREE_LIST (p + cell_size); + set_lookup_table (p, ph); + p += cell_size; + } +#ifdef ERROR_CHECK_GC + assert (!LRECORD_FREE_P (p)); + MARK_LRECORD_AS_FREE (p); +#endif + NEXT_FREE (p) = 0; + set_lookup_table (p, ph); + + /* hook free list into header */ + PH_FREE_LIST (ph) = FREE_LIST (PH_HEAP_SPACE (ph)); +} + + +/* Cleans the object space of the given page_header. */ +static void +remove_cell_free_list (page_header *ph) +{ +#if ZERO_MEM + ZERO_HEAP_SPACE (ph); +#endif + PH_FREE_LIST (ph) = 0; +} + + +/* Installs a new page and hooks it into given page_list_header. */ +static page_header * +install_page_in_used_list (page_header *ph, page_list_header *plh, + size_t size, int managed) +{ + /* add to list */ + add_page_header_to_plh (ph, plh); + + /* determine cell size */ + if (PLH_SIZE (plh)) + PH_CELL_SIZE (ph) = PLH_SIZE (plh); + else + PH_CELL_SIZE (ph) = size; + PH_CELLS_ON_PAGE (ph) = (PAGE_SIZE * PH_N_PAGES (ph)) / PH_CELL_SIZE (ph); + + /* init cell count */ + PH_CELLS_USED (ph) = 0; + + /* install mark bits and initialize cell free list */ + if (managed) + install_mark_bits (ph); + + install_cell_free_list (ph); + +#ifdef MEMORY_USAGE_STATS + PLH_TOTAL_CELLS (plh) += PH_CELLS_ON_PAGE (ph); + PLH_TOTAL_SPACE (plh) += PAGE_SIZE * PH_N_PAGES (ph); +#endif + + return ph; +} + + +/* Cleans and frees a page, identified by the given page_header. */ +static void +remove_page_from_used_list (page_header *ph) +{ + page_list_header *plh = PH_PLH (ph); + +#ifdef MEMORY_USAGE_STATS + PLH_TOTAL_CELLS (plh) -= PH_CELLS_ON_PAGE (ph); + PLH_TOTAL_SPACE (plh) -= PAGE_SIZE * PH_N_PAGES (ph); +#endif + + /* clean up mark bits and cell free list */ + remove_cell_free_list (ph); + if (PH_ON_USED_LIST_P (ph)) + remove_mark_bits (ph); + + /* clean up page header */ + PH_CELL_SIZE (ph) = 0; + PH_CELLS_ON_PAGE (ph) = 0; + PH_CELLS_USED (ph) = 0; + + /* remove from used list */ + remove_page_header_from_plh (ph, plh); + + /* move to free list */ + merge_into_free_list (ph); +} + + + + +/*--- allocation -------------------------------------------------------*/ + +/* Allocates from cell free list on already allocated pages. */ +static page_header * +allocate_cell (page_list_header *plh) +{ + page_header *ph = PLH_FIRST (plh); + if (ph) + { + if (PH_FREE_LIST (ph)) + /* elements free on first page */ + return ph; + else if ((PH_NEXT (ph)) + && (PH_FREE_LIST (PH_NEXT (ph)))) + /* elements free on second page */ + { + page_header *temp = PH_NEXT (ph); + /* move full page (first page) to end of list */ + PH_NEXT (PLH_LAST (plh)) = ph; + PH_PREV (ph) = PLH_LAST (plh); + PLH_LAST (plh) = ph; + PH_NEXT (ph) = 0; + /* install second page as first page */ + ph = temp; + PH_PREV (ph) = 0; + PLH_FIRST (plh) = ph; + return ph; + } + } + return 0; +} + + +/* Finds a page which has at least the needed number of pages. + Algorithm: FIRST FIT. */ +static page_header * +find_free_page_first_fit (EMACS_INT needed_pages, page_header *ph) +{ + while (ph) + { + if (PH_N_PAGES (ph) >= needed_pages) + return ph; + ph = PH_NEXT (ph); + } + return 0; +} + + +/* Allocates a page from the free list. */ +static page_header * +allocate_page_from_free_list (EMACS_INT needed_pages) +{ + page_header *ph = 0; + int i; + for (i = get_free_list_index (needed_pages); i < N_FREE_PAGE_LISTS; i++) + if ((ph = find_free_page_first_fit (needed_pages, + PLH_FIRST (FREE_HEAP_PAGES (i)))) != 0) + { + if (PH_N_PAGES (ph) > needed_pages) + return split_page (ph, needed_pages); + else + { + remove_page_from_free_list (ph); + return ph; + } + } + return 0; +} + + +/* Allocates a new page, either from free list or by expanding the heap. */ +static page_header * +allocate_new_page (page_list_header *plh, size_t size, int managed) +{ + EMACS_INT needed_pages = BYTES_TO_PAGES (size); + /* first check free list */ + page_header *result = allocate_page_from_free_list (needed_pages); + if (!result) + /* expand heap */ + result = expand_heap (needed_pages); + install_page_in_used_list (result, plh, size, managed); + return result; +} + + +/* Selects the correct size class, tries to allocate a cell of this size + from the free list, if this fails, a new page is allocated. */ +static void * +mc_alloc_1 (size_t size, int managed) +{ + page_list_header *plh = 0; + if (managed) + plh = USED_HEAP_PAGES (get_used_list_index (size)); + else + plh = UNMANAGED_HEAP_PAGES (get_unmanaged_list_index (size)); + + page_header *ph = 0; + void *result = 0; + if (size == 0) + return 0; + if (size < PAGE_SIZE_DIV_2) + /* first check any free cells */ + ph = allocate_cell (plh); + if (!ph) + /* allocate a new page */ + ph = allocate_new_page (plh, size, managed); + + /* return first element of free list and remove it from the list */ + result = (void*) PH_FREE_LIST (ph); + PH_FREE_LIST (ph) = + NEXT_FREE (PH_FREE_LIST (ph)); + + memset (result, '\0', size); + if (managed) + MARK_LRECORD_AS_FREE (result); + + /* bump used cells counter */ + PH_CELLS_USED (ph)++; + +#ifdef MEMORY_USAGE_STATS + PLH_USED_CELLS (plh)++; + if (managed) + PLH_USED_SPACE (plh) += size; + else + PLH_USED_SPACE (plh) += PLH_SIZE (plh); +#endif + + return result; +} + +void * +mc_alloc (size_t size) +{ + return mc_alloc_1 (size, 1); +} + +void * +mc_alloc_unmanaged (size_t size) +{ + return mc_alloc_1 (size, 0); +} + + + + +/*--- sweep & free & finalize-------------------------------------------*/ + +/* Frees a heap pointer. */ +static void +remove_cell (void *ptr, page_header *ph) +{ +#ifdef MEMORY_USAGE_STATS + PLH_USED_CELLS (PH_PLH (ph))--; + if (PH_ON_USED_LIST_P (ph)) + PLH_USED_SPACE (PH_PLH (ph)) -= + detagged_lisp_object_size ((const struct lrecord_header *) ptr); + else + PLH_USED_SPACE (PH_PLH (ph)) -= PH_CELL_SIZE (ph); +#endif +#ifdef ERROR_CHECK_GC + if (PH_ON_USED_LIST_P (ph)) { +#ifdef MC_ALLOC_TYPE_STATS + dec_lrecord_stats (PH_CELL_SIZE (ph), + (const struct lrecord_header *) ptr); +#endif /* MC_ALLOC_TYPE_STATS */ + assert (!LRECORD_FREE_P (ptr)); + deadbeef_memory (ptr, PH_CELL_SIZE (ph)); + MARK_LRECORD_AS_FREE (ptr); + } +#endif + + /* hooks cell into free list */ + NEXT_FREE (ptr) = PH_FREE_LIST (ph); + PH_FREE_LIST (ph) = FREE_LIST (ptr); + /* decrease cells used */ + PH_CELLS_USED (ph)--; +} + + +/* Mark free list marks all free list entries. */ +static void +mark_free_list (page_header *ph) +{ + free_link *fl = PH_FREE_LIST (ph); + while (fl) + { + SET_BIT (ph, get_mark_bit_index (fl, ph), 1); + fl = NEXT_FREE (fl); + } +} + +/* Finalize a page. You have to tell mc-alloc how to call your + object's finalizer. Therefore, you have to define the macro + MC_ALLOC_CALL_FINALIZER(ptr). This macro should do nothing else + then test if there is a finalizer and call it on the given + argument, which is the heap address of the object. */ +static void +finalize_page (page_header *ph) +{ + EMACS_INT heap_space = (EMACS_INT) PH_HEAP_SPACE (ph); + EMACS_INT heap_space_step = PH_CELL_SIZE (ph); + EMACS_INT mark_bit = 0; + EMACS_INT mark_bit_max_index = PH_CELLS_ON_PAGE (ph); + int bit = 0; + + mark_free_list (ph); + + for (mark_bit = 0; mark_bit < mark_bit_max_index; mark_bit++) + { + GET_BIT (bit, ph, mark_bit); + if (!bit) + { + EMACS_INT ptr = (heap_space + (heap_space_step * mark_bit)); + MC_ALLOC_CALL_FINALIZER ((void *) ptr); + } + } +} + + +/* Finalize a page for disksave. XEmacs calls this routine before it + dumps the heap image. You have to tell mc-alloc how to call your + object's finalizer for disksave. Therefore, you have to define the + macro MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE(ptr). This macro should + do nothing else then test if there is a finalizer and call it on + the given argument, which is the heap address of the object. */ +static void +finalize_page_for_disksave (page_header *ph) +{ + EMACS_INT heap_space = (EMACS_INT) PH_HEAP_SPACE (ph); + EMACS_INT heap_space_step = PH_CELL_SIZE (ph); + EMACS_INT mark_bit = 0; + EMACS_INT mark_bit_max_index = PH_CELLS_ON_PAGE (ph); + + mark_free_list (ph); + + for (mark_bit = 0; mark_bit < mark_bit_max_index; mark_bit++) + { + EMACS_INT ptr = (heap_space + (heap_space_step * mark_bit)); + MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE ((void *) ptr); + } +} + + +/* Finalizes the heap. */ +void +mc_finalize (void) +{ + visit_all_used_page_headers (finalize_page); +} + + +/* Finalizes the heap for disksave. */ +void +mc_finalize_for_disksave (void) +{ + visit_all_used_page_headers (finalize_page_for_disksave); +} + + +/* Sweeps a page: all the non-marked cells are freed. If the page is empty + in the end, it is removed. If some cells are free, it is moved to the + front of its page header list. Full pages stay where they are. */ +static void +sweep_page (page_header *ph) +{ + char *heap_space = (char *) PH_HEAP_SPACE (ph); + EMACS_INT heap_space_step = PH_CELL_SIZE (ph); + EMACS_INT mark_bit = 0; + EMACS_INT mark_bit_max_index = PH_CELLS_ON_PAGE (ph); + int bit = 0; + + mark_free_list (ph); + + for (mark_bit = 0; mark_bit < mark_bit_max_index; mark_bit++) + { + GET_BIT (bit, ph, mark_bit); + if (!bit) + { + remove_cell (heap_space + (heap_space_step * mark_bit), ph); + } + } + zero_mark_bits (ph); + if (PH_CELLS_USED (ph) == 0) + remove_page_from_used_list (ph); + else if (PH_CELLS_USED (ph) < PH_CELLS_ON_PAGE (ph)) + move_page_header_to_front (ph); +} + + +/* Sweeps the heap. */ +void +mc_sweep (void) +{ + visit_all_used_page_headers (sweep_page); +} + + +/* Frees the cell pointed to by ptr. */ +void +mc_free (void *ptr) +{ + page_header *ph = get_page_header (ptr); + assert (!PH_ON_FREE_LIST_P (ph)); + + remove_cell (ptr, ph); + + if (PH_CELLS_USED (ph) == 0) + remove_page_from_used_list (ph); + else if (PH_CELLS_USED (ph) < PH_CELLS_ON_PAGE (ph)) + move_page_header_to_front (ph); +} + + +/* Changes the size of the cell pointed to by ptr. + Returns the new address of the new cell with new size. */ +void * +mc_realloc_1 (void *ptr, size_t size, int managed) +{ + if (ptr) + { + if (size) + { + void *result = mc_alloc_1 (size, managed); + size_t from_size = PH_CELL_SIZE (get_page_header (ptr)); + size_t cpy_size = size; + if (size > from_size) + cpy_size = from_size; + memcpy (result, ptr, cpy_size); + mc_free (ptr); + return result; + } + else + { + mc_free (ptr); + return 0; + } + } + else + return mc_alloc_1 (size, managed); +} + +void * +mc_realloc (void *ptr, size_t size) +{ + return mc_realloc_1 (ptr, size, 1); +} + +void * +mc_realloc_unmanaged (void *ptr, size_t size) +{ + return mc_realloc_1 (ptr, size, 0); +} + + + + +/*--- initialization ---------------------------------------------------*/ + +/* Call once at the very beginning. */ +void +init_mc_allocator (void) +{ + int i; + + for (i = 0; i < N_USED_PAGE_LISTS; i++) + { + page_list_header *plh = USED_HEAP_PAGES (i); + PLH_LIST_TYPE (plh) = USED_LIST; + PLH_SIZE (plh) = get_used_list_size_value (i); + PLH_FIRST (plh) = 0; + PLH_LAST (plh) = 0; + PLH_MARK_BIT_FREE_LIST (plh) = 0; +#ifdef MEMORY_USAGE_STATS + PLH_PAGE_COUNT (plh) = 0; + PLH_USED_CELLS (plh) = 0; + PLH_USED_SPACE (plh) = 0; + PLH_TOTAL_CELLS (plh) = 0; + PLH_TOTAL_SPACE (plh) = 0; +#endif + } + + for (i = 0; i < N_UNMANAGED_PAGE_LISTS; i++) + { + page_list_header *plh = UNMANAGED_HEAP_PAGES (i); + PLH_LIST_TYPE (plh) = UNMANAGED_LIST; + PLH_SIZE (plh) = get_unmanaged_list_size_value (i); + PLH_FIRST (plh) = 0; + PLH_LAST (plh) = 0; + PLH_MARK_BIT_FREE_LIST (plh) = 0; +#ifdef MEMORY_USAGE_STATS + PLH_PAGE_COUNT (plh) = 0; + PLH_USED_CELLS (plh) = 0; + PLH_USED_SPACE (plh) = 0; + PLH_TOTAL_CELLS (plh) = 0; + PLH_TOTAL_SPACE (plh) = 0; +#endif + } + + for (i = 0; i < N_FREE_PAGE_LISTS; i++) + { + page_list_header *plh = FREE_HEAP_PAGES (i); + PLH_LIST_TYPE (plh) = FREE_LIST; + PLH_SIZE (plh) = get_free_list_size_value (i); + PLH_FIRST (plh) = 0; + PLH_LAST (plh) = 0; + PLH_MARK_BIT_FREE_LIST (plh) = 0; +#ifdef MEMORY_USAGE_STATS + PLH_PAGE_COUNT (plh) = 0; + PLH_USED_CELLS (plh) = 0; + PLH_USED_SPACE (plh) = 0; + PLH_TOTAL_CELLS (plh) = 0; + PLH_TOTAL_SPACE (plh) = 0; +#endif + } + + PAGE_HEADER_FREE_LIST = 0; + +#ifdef MEMORY_USAGE_STATS + MC_MALLOCED_BYTES = sizeof (mc_allocator_globals); +#endif + + init_lookup_table (); +} + + + + +/*--- lisp function for statistics -------------------------------------*/ + +#ifdef MEMORY_USAGE_STATS +DEFUN ("mc-alloc-memory-usage", Fmc_alloc_memory_usage, 0, 0, 0, /* +Returns stats about the mc-alloc memory usage. See diagnose.el. +*/ + ()) +{ + Lisp_Object free_plhs = Qnil; + Lisp_Object used_plhs = Qnil; + Lisp_Object unmanaged_plhs = Qnil; + Lisp_Object heap_sects = Qnil; + int used_size = 0; + int real_size = 0; + + int i; + + for (i = 0; i < N_FREE_PAGE_LISTS; i++) + if (PLH_PAGE_COUNT (FREE_HEAP_PAGES(i)) > 0) + free_plhs = + acons (make_int (PLH_SIZE (FREE_HEAP_PAGES(i))), + list1 (make_int (PLH_PAGE_COUNT (FREE_HEAP_PAGES(i)))), + free_plhs); + + for (i = 0; i < N_UNMANAGED_PAGE_LISTS; i++) + if (PLH_PAGE_COUNT (UNMANAGED_HEAP_PAGES(i)) > 0) + unmanaged_plhs = + acons (make_int (PLH_SIZE (UNMANAGED_HEAP_PAGES(i))), + list5 (make_int (PLH_PAGE_COUNT (UNMANAGED_HEAP_PAGES(i))), + make_int (PLH_USED_CELLS (UNMANAGED_HEAP_PAGES(i))), + make_int (PLH_USED_SPACE (UNMANAGED_HEAP_PAGES(i))), + make_int (PLH_TOTAL_CELLS (UNMANAGED_HEAP_PAGES(i))), + make_int (PLH_TOTAL_SPACE (UNMANAGED_HEAP_PAGES(i)))), + unmanaged_plhs); + + for (i = 0; i < N_USED_PAGE_LISTS; i++) + if (PLH_PAGE_COUNT (USED_HEAP_PAGES(i)) > 0) + used_plhs = + acons (make_int (PLH_SIZE (USED_HEAP_PAGES(i))), + list5 (make_int (PLH_PAGE_COUNT (USED_HEAP_PAGES(i))), + make_int (PLH_USED_CELLS (USED_HEAP_PAGES(i))), + make_int (PLH_USED_SPACE (USED_HEAP_PAGES(i))), + make_int (PLH_TOTAL_CELLS (USED_HEAP_PAGES(i))), + make_int (PLH_TOTAL_SPACE (USED_HEAP_PAGES(i)))), + used_plhs); + + for (i = 0; i < N_HEAP_SECTIONS; i++) { + used_size += HEAP_SECTION(i).n_pages * PAGE_SIZE; + real_size += + malloced_storage_size (0, HEAP_SECTION(i).real_size, 0); + } + + heap_sects = + list3 (make_int (N_HEAP_SECTIONS), + make_int (used_size), + make_int (real_size)); + + return Fcons (make_int (PAGE_SIZE), + list6 (heap_sects, + Fnreverse (used_plhs), + Fnreverse (unmanaged_plhs), + Fnreverse (free_plhs), + make_int (sizeof (mc_allocator_globals)), + make_int (MC_MALLOCED_BYTES))); +} +#endif /* MEMORY_USAGE_STATS */ + +void +syms_of_mc_alloc (void) +{ +#ifdef MEMORY_USAGE_STATS + DEFSUBR (Fmc_alloc_memory_usage); +#endif /* MEMORY_USAGE_STATS */ +} diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/mc-alloc.h mc-xemacs-21.5/src/mc-alloc.h --- xemacs-21.5/src/mc-alloc.h 1970-01-01 01:00:00.000000000 +0100 +++ mc-xemacs-21.5/src/mc-alloc.h 2005-03-23 02:48:52.000000000 +0100 ＠＠ -0,0 +1,133 ＠＠ +/* New allocator for XEmacs. + Copyright (C) 2005 Marcus Crestani. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +#ifndef INCLUDED_mc_alloc_h_ +#define INCLUDED_mc_alloc_h_ + + +/* This is moved here from alloc.c. */ +#ifndef MALLOC_OVERHEAD +# ifdef GNU_MALLOC +# define MALLOC_OVERHEAD 0 +# elif defined (rcheck) +# define MALLOC_OVERHEAD 20 +# else +# define MALLOC_OVERHEAD 8 +# endif +#endif /* MALLOC_OVERHEAD */ + + +/* This enables type based information (updated during gc). The output + is used by show-memory-usage to print memory information for each + type. Since the new allocator does not distinguish between types + anymore, this functionality is additionally implemented and + consumes a lot of time. That is why it is kept conditioned on a + separate flag called MC_ALLOC_TYPE_STATS. */ +#if 1 +# define MC_ALLOC_TYPE_STATS 1 +#endif + + +/*--- prototypes -------------------------------------------------------*/ + +BEGIN_C_DECLS + + + +/* Allocation related functions and macros: */ + +/* Builds and initializes all needed datastructures of the new allocator. */ +void init_mc_allocator (void); + +/* Returns a pointer to a block of memory of given size on the used heap. */ +void *mc_alloc (size_t size); + +/* Frees the object pointed to by pointer. */ +void mc_free (void *ptr); + +/* Modifies the size of the memory block pointed to by ptr. The + Address of the new block of given size is returned. */ +void *mc_realloc (void *ptr, size_t size); + + + +/* Garbage collection related functions and macros: */ + +/* Set the mark bit of the object pointed to by ptr to value.*/ +void set_mark_bit (void *ptr, EMACS_INT value); + +/* Return the mark bit of the object pointed to by ptr. */ +EMACS_INT get_mark_bit (void *ptr); + +/* mark bit macros */ +/* Returns true if the mark bit of the object pointed to by ptr is set. */ +#define MARKED_P(ptr) (get_mark_bit (ptr) == 1) + +/* Marks the object pointed to by ptr (sets the mark bit to 1). */ +#define MARK(ptr) set_mark_bit (ptr, 1) + +/* Unmarks the object pointed to by ptr (sets the mark bit to 0). */ +#define UNMARK(ptr) set_mark_bit (ptr, 0) + +/* The finalizer of every not marked object is called. The macro + MC_ALLOC_CALL_FINALIZER has to be defined and call the finalizer of + the object. */ +void mc_finalize (void); + +/* All not marked objects of the used heap are freed. */ +void mc_sweep (void); + + + +/* Portable dumper related functions and macros: */ + +/* The finalizer for disksave of every object is called to shrink the + dump image. The macro MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE has to + be defined and call the finalizer for disksave of the object. */ +void mc_finalize_for_disksave (void); + + + +/* Allocation function for the unmanaged heap: */ + +/* Returns a pointer to a block of memory of given size on the + unmanaged heap. */ +void *mc_alloc_unmanaged (size_t size); + +/* Modifies the size of the memory block pointed to by ptr. The + Address of the new block of given size is returned. */ +void *mc_realloc_unmanaged (void *ptr, size_t size); + + + +/* Functions and macros related with allocation statistics: */ + +#ifdef MEMORY_USAGE_STATS +/* Returns the real size, including overhead, which is actually alloced + for an object with given claimed_size. */ +Bytecount mc_alloced_storage_size (Bytecount claimed_size, + struct overhead_stats *stats); +#endif /* MEMORY_USAGE_STATS */ + +END_C_DECLS + +#endif /* INCLUDED_mc_alloc_h_ */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/mule-charset.c mc-xemacs-21.5/src/mule-charset.c --- xemacs-21.5/src/mule-charset.c 2005-03-03 00:41:01.000000000 +0100 +++ mc-xemacs-21.5/src/mule-charset.c 2005-03-19 00:47:08.000000000 +0100 ＠＠ -197,7 +197,11 ＠＠ if (!overwrite) { +#ifdef MC_ALLOC + cs = alloc_lrecord_type (Lisp_Charset, &lrecord_charset); +#else /* not MC_ALLOC */ cs = alloc_lcrecord_type (Lisp_Charset, &lrecord_charset); +#endif /* not MC_ALLOC */ obj = wrap_charset (cs); if (final) ＠＠ -880,7 +884,11 ＠＠ { struct Lisp_Charset *c = XCHARSET (charset); xzero (*stats); +#ifdef MC_ALLOC + stats->other += mc_alloced_storage_size (sizeof (*c), ovstats); +#else /* not MC_ALLOC */ stats->other += malloced_storage_size (c, sizeof (*c), ovstats); +#endif /* not MC_ALLOC */ stats->from_unicode += compute_from_unicode_table_size (charset, ovstats); stats->to_unicode += compute_to_unicode_table_size (charset, ovstats); } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/objects.c mc-xemacs-21.5/src/objects.c --- xemacs-21.5/src/objects.c 2005-03-03 00:41:02.000000000 +0100 +++ mc-xemacs-21.5/src/objects.c 2005-02-03 22:03:00.000000000 +0100 ＠＠ -178,7 +178,11 ＠＠ CHECK_STRING (name); device = wrap_device (decode_device (device)); +#ifdef MC_ALLOC + c = alloc_lrecord_type (Lisp_Color_Instance, &lrecord_color_instance); +#else /* not MC_ALLOC */ c = alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance); +#endif /* not MC_ALLOC */ c->name = name; c->device = device; c->data = 0; ＠＠ -387,7 +391,11 ＠＠ device = wrap_device (decode_device (device)); +#ifdef MC_ALLOC + f = alloc_lrecord_type (Lisp_Font_Instance, &lrecord_font_instance); +#else /* not MC_ALLOC */ f = alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance); +#endif /* not MC_ALLOC */ f->name = name; f->truename = Qnil; f->device = device; ＠＠ -1198,7 +1206,11 ＠＠ staticpro_nodump (&Vthe_null_color_instance); { Lisp_Color_Instance *c = +#ifdef MC_ALLOC + alloc_lrecord_type (Lisp_Color_Instance, &lrecord_color_instance); +#else /* not MC_ALLOC */ alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance); +#endif /* not MC_ALLOC */ c->name = Qnil; c->device = Qnil; c->data = 0; ＠＠ -1209,7 +1221,11 ＠＠ staticpro_nodump (&Vthe_null_font_instance); { Lisp_Font_Instance *f = +#ifdef MC_ALLOC + alloc_lrecord_type (Lisp_Font_Instance, &lrecord_font_instance); +#else /* not MC_ALLOC */ alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance); +#endif /* not MC_ALLOC */ f->name = Qnil; f->truename = Qnil; f->device = Qnil; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/objects-impl.h mc-xemacs-21.5/src/objects-impl.h --- xemacs-21.5/src/objects-impl.h 2005-03-03 00:41:02.000000000 +0100 +++ mc-xemacs-21.5/src/objects-impl.h 2005-02-01 22:58:22.000000000 +0100 ＠＠ -99,7 +99,11 ＠＠ struct Lisp_Color_Instance { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object name; Lisp_Object device; ＠＠ -119,7 +123,11 ＠＠ struct Lisp_Font_Instance { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ 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, diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/opaque.c mc-xemacs-21.5/src/opaque.c --- xemacs-21.5/src/opaque.c 2005-03-03 00:41:02.000000000 +0100 +++ mc-xemacs-21.5/src/opaque.c 2005-02-01 22:58:27.000000000 +0100 ＠＠ -38,7 +38,9 ＠＠ #include "lisp.h" #include "opaque.h" +#ifndef MC_ALLOC Lisp_Object Vopaque_ptr_free_list; +#endif /* not MC_ALLOC */ /* Should never, ever be called. (except by an external debugger) */ static void ＠＠ -73,7 +75,11 ＠＠ make_opaque (const void *data, Bytecount size) { Lisp_Opaque *p = (Lisp_Opaque *) +#ifdef MC_ALLOC + alloc_lrecord (aligned_sizeof_opaque (size), &lrecord_opaque); +#else /* not MC_ALLOC */ basic_alloc_lcrecord (aligned_sizeof_opaque (size), &lrecord_opaque); +#endif /* not MC_ALLOC */ p->size = size; if (data == OPAQUE_CLEAR) ＠＠ -160,7 +166,13 ＠＠ Lisp_Object make_opaque_ptr (void *val) { +#ifdef MC_ALLOC + Lisp_Object res = + wrap_pointer_1 (alloc_lrecord_type (Lisp_Opaque_Ptr, + &lrecord_opaque_ptr)); +#else /* not MC_ALLOC */ Lisp_Object res = alloc_managed_lcrecord (Vopaque_ptr_free_list); +#endif /* not MC_ALLOC */ set_opaque_ptr (res, val); return res; } ＠＠ -171,9 +183,14 ＠＠ void free_opaque_ptr (Lisp_Object ptr) { +#ifdef MC_ALLOC + free_lrecord (ptr); +#else /* not MC_ALLOC */ free_managed_lcrecord (Vopaque_ptr_free_list, ptr); +#endif /* not MC_ALLOC */ } +#ifndef MC_ALLOC void reinit_opaque_early (void) { ＠＠ -181,6 +198,7 ＠＠ &lrecord_opaque_ptr); staticpro_nodump (&Vopaque_ptr_free_list); } +#endif /* not MC_ALLOC */ void init_opaque_once_early (void) ＠＠ -188,5 +206,7 ＠＠ INIT_LRECORD_IMPLEMENTATION (opaque); INIT_LRECORD_IMPLEMENTATION (opaque_ptr); +#ifndef MC_ALLOC reinit_opaque_early (); +#endif /* not MC_ALLOC */ } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/opaque.h mc-xemacs-21.5/src/opaque.h --- xemacs-21.5/src/opaque.h 2005-03-03 00:41:02.000000000 +0100 +++ mc-xemacs-21.5/src/opaque.h 2005-02-01 22:58:27.000000000 +0100 ＠＠ -28,7 +28,11 ＠＠ typedef struct Lisp_Opaque { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Bytecount size; max_align_t data[1]; } Lisp_Opaque; ＠＠ -54,7 +58,11 ＠＠ typedef struct Lisp_Opaque_Ptr { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ void *ptr; } Lisp_Opaque_Ptr; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/print.c mc-xemacs-21.5/src/print.c --- xemacs-21.5/src/print.c 2005-03-03 00:41:02.000000000 +0100 +++ mc-xemacs-21.5/src/print.c 2005-03-25 02:16:36.000000000 +0100 ＠＠ -1444,17 +1444,30 ＠＠ default_object_printer (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag)) { +#ifdef MC_ALLOC + struct lrecord_header *header = + (struct lrecord_header *) XPNTR (obj); +#else /* not MC_ALLOC */ struct lcrecord_header *header = (struct lcrecord_header *) XPNTR (obj); +#endif /* not MC_ALLOC */ if (print_readably) printing_unreadable_object ("#<%s 0x%x>", +#ifdef MC_ALLOC + LHEADER_IMPLEMENTATION (header)->name, +#else /* not MC_ALLOC */ LHEADER_IMPLEMENTATION (&header->lheader)->name, +#endif /* not MC_ALLOC */ header->uid); write_fmt_string (printcharfun, "#<%s 0x%x>", +#ifdef MC_ALLOC + LHEADER_IMPLEMENTATION (header)->name, +#else /* not MC_ALLOC */ LHEADER_IMPLEMENTATION (&header->lheader)->name, +#endif /* not MC_ALLOC */ header->uid); } ＠＠ -1676,6 +1689,7 ＠＠ } } +#ifndef MC_ALLOC if (lheader->type == lrecord_type_free) { printing_major_badness (printcharfun, "freed lrecord", 0, ＠＠ -1688,6 +1702,7 ＠＠ lheader, BADNESS_NO_TYPE); break; } +#endif /* not MC_ALLOC */ else if ((int) (lheader->type) >= lrecord_type_count) { printing_major_badness (printcharfun, "illegal lrecord type", ＠＠ -2192,11 +2207,17 ＠＠ debug_out ("<< bad object type=%d 0x%lx>>", header->type, (EMACS_INT) header); else +#ifdef MC_ALLOC + debug_out ("#<%s 0x%lx>", + LHEADER_IMPLEMENTATION (header)->name, + (EMACS_INT) ((struct lrecord_header *) header)->uid); +#else /* not MC_ALLOC */ debug_out ("#<%s 0x%lx>", LHEADER_IMPLEMENTATION (header)->name, LHEADER_IMPLEMENTATION (header)->basic_p ? (EMACS_INT) header : ((struct lcrecord_header *) header)->uid); +#endif /* not MC_ALLOC */ } inhibit_non_essential_conversion_operations = 0; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/process.c mc-xemacs-21.5/src/process.c --- xemacs-21.5/src/process.c 2005-03-03 00:41:03.000000000 +0100 +++ mc-xemacs-21.5/src/process.c 2005-02-01 22:58:28.000000000 +0100 ＠＠ -483,7 +483,11 ＠＠ { Lisp_Object val, name1; int i; +#ifdef MC_ALLOC + Lisp_Process *p = alloc_lrecord_type (Lisp_Process, &lrecord_process); +#else /* not MC_ALLOC */ Lisp_Process *p = alloc_lcrecord_type (Lisp_Process, &lrecord_process); +#endif /* not MC_ALLOC */ #define MARKED_SLOT(x) p->x = Qnil; #include "process-slots.h" diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/procimpl.h mc-xemacs-21.5/src/procimpl.h --- xemacs-21.5/src/procimpl.h 2005-03-03 00:41:03.000000000 +0100 +++ mc-xemacs-21.5/src/procimpl.h 2005-02-01 22:58:28.000000000 +0100 ＠＠ -94,7 +94,11 ＠＠ struct Lisp_Process { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ /* Exit code if process has terminated, signal which stopped/interrupted process diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/rangetab.c mc-xemacs-21.5/src/rangetab.c --- xemacs-21.5/src/rangetab.c 2005-03-03 00:41:03.000000000 +0100 +++ mc-xemacs-21.5/src/rangetab.c 2005-02-03 22:03:01.000000000 +0100 ＠＠ -328,8 +328,13 ＠＠ */ (type)) { +#ifdef MC_ALLOC + Lisp_Range_Table *rt = alloc_lrecord_type (Lisp_Range_Table, + &lrecord_range_table); +#else /* not MC_ALLOC */ Lisp_Range_Table *rt = alloc_lcrecord_type (Lisp_Range_Table, &lrecord_range_table); +#endif /* not MC_ALLOC */ rt->entries = Dynarr_new (range_table_entry); rt->type = range_table_symbol_to_type (type); return wrap_range_table (rt); ＠＠ -347,7 +352,11 ＠＠ CHECK_RANGE_TABLE (range_table); rt = XRANGE_TABLE (range_table); +#ifdef MC_ALLOC + rtnew = alloc_lrecord_type (Lisp_Range_Table, &lrecord_range_table); +#else /* not MC_ALLOC */ rtnew = alloc_lcrecord_type (Lisp_Range_Table, &lrecord_range_table); +#endif /* not MC_ALLOC */ rtnew->entries = Dynarr_new (range_table_entry); rtnew->type = rt->type; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/rangetab.h mc-xemacs-21.5/src/rangetab.h --- xemacs-21.5/src/rangetab.h 2005-03-03 00:41:03.000000000 +0100 +++ mc-xemacs-21.5/src/rangetab.h 2005-02-01 22:58:22.000000000 +0100 ＠＠ -49,7 +49,11 ＠＠ struct Lisp_Range_Table { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ range_table_entry_dynarr *entries; enum range_table_type type; }; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/scrollbar.c mc-xemacs-21.5/src/scrollbar.c --- xemacs-21.5/src/scrollbar.c 2005-03-03 00:41:06.000000000 +0100 +++ mc-xemacs-21.5/src/scrollbar.c 2005-03-19 00:47:26.000000000 +0100 ＠＠ -199,8 +199,13 ＠＠ { struct device *d = XDEVICE (f->device); struct scrollbar_instance *instance = +#ifdef MC_ALLOC + alloc_lrecord_type (struct scrollbar_instance, + &lrecord_scrollbar_instance); +#else /* not MC_ALLOC */ alloc_lcrecord_type (struct scrollbar_instance, &lrecord_scrollbar_instance); +#endif /* not MC_ALLOC */ MAYBE_DEVMETH (d, create_scrollbar_instance, (f, vertical, instance)); ＠＠ -272,7 +277,11 ＠＠ while (inst) { +#ifdef MC_ALLOC + total += mc_alloced_storage_size (sizeof (*inst), ovstats); +#else /* not MC_ALLOC */ total += malloced_storage_size (inst, sizeof (*inst), ovstats); +#endif /* not MC_ALLOC */ inst = inst->next; } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/scrollbar-gtk.c mc-xemacs-21.5/src/scrollbar-gtk.c --- xemacs-21.5/src/scrollbar-gtk.c 2005-03-03 00:41:06.000000000 +0100 +++ mc-xemacs-21.5/src/scrollbar-gtk.c 2005-03-19 00:47:40.000000000 +0100 ＠＠ -484,7 +484,11 ＠＠ struct gtk_scrollbar_data *data = (struct gtk_scrollbar_data *) inst->scrollbar_data; +#ifdef MC_ALLOC + total += mc_alloced_storage_size (sizeof (*data), ovstats); +#else /* not MC_ALLOC */ total += malloced_storage_size (data, sizeof (*data), ovstats); +#endif /* not MC_ALLOC */ inst = inst->next; } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/scrollbar.h mc-xemacs-21.5/src/scrollbar.h --- xemacs-21.5/src/scrollbar.h 2005-03-03 00:41:06.000000000 +0100 +++ mc-xemacs-21.5/src/scrollbar.h 2005-02-01 22:58:27.000000000 +0100 ＠＠ -27,7 +27,11 ＠＠ struct scrollbar_instance { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ /* Used by the frame caches. */ struct scrollbar_instance *next; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/scrollbar-msw.c mc-xemacs-21.5/src/scrollbar-msw.c --- xemacs-21.5/src/scrollbar-msw.c 2005-03-03 00:41:06.000000000 +0100 +++ mc-xemacs-21.5/src/scrollbar-msw.c 2005-03-19 00:52:19.000000000 +0100 ＠＠ -433,7 +433,11 ＠＠ struct mswindows_scrollbar_data *data = (struct mswindows_scrollbar_data *) inst->scrollbar_data; +#ifdef MC_ALLOC + total += mc_alloced_storage_size (sizeof (*data), ovstats); +#else /* not MC_ALLOC */ total += malloced_storage_size (data, sizeof (*data), ovstats); +#endif /* not MC_ALLOC */ inst = inst->next; } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/scrollbar-x.c mc-xemacs-21.5/src/scrollbar-x.c --- xemacs-21.5/src/scrollbar-x.c 2005-03-03 00:41:06.000000000 +0100 +++ mc-xemacs-21.5/src/scrollbar-x.c 2005-03-19 00:48:24.000000000 +0100 ＠＠ -703,9 +703,14 ＠＠ struct x_scrollbar_data *data = (struct x_scrollbar_data *) inst->scrollbar_data; +#ifdef MC_ALLOC + total += mc_alloced_storage_size (sizeof (*data), ovstats); + total += mc_alloced_storage_size (1 + strlen (data->name), ovstats); +#else /* not MC_ALLOC */ total += malloced_storage_size (data, sizeof (*data), ovstats); total += malloced_storage_size (data->name, 1 + strlen (data->name), ovstats); +#endif /* not MC_ALLOC */ inst = inst->next; } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/specifier.c mc-xemacs-21.5/src/specifier.c --- xemacs-21.5/src/specifier.c 2005-03-03 00:41:07.000000000 +0100 +++ mc-xemacs-21.5/src/specifier.c 2005-02-03 22:03:06.000000000 +0100 ＠＠ -494,8 +494,13 ＠＠ { Lisp_Object specifier; Lisp_Specifier *sp = (Lisp_Specifier *) +#ifdef MC_ALLOC + alloc_lrecord (aligned_sizeof_specifier (data_size), + &lrecord_specifier); +#else /* not MC_ALLOC */ basic_alloc_lcrecord (aligned_sizeof_specifier (data_size), &lrecord_specifier); +#endif /* not MC_ALLOC */ sp->methods = spec_meths; sp->global_specs = Qnil; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/specifier.h mc-xemacs-21.5/src/specifier.h --- xemacs-21.5/src/specifier.h 2005-03-03 00:41:07.000000000 +0100 +++ mc-xemacs-21.5/src/specifier.h 2005-02-01 22:58:28.000000000 +0100 ＠＠ -216,7 +216,11 ＠＠ struct Lisp_Specifier { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ struct specifier_methods *methods; /* we keep a chained list of all current specifiers, for GC cleanup diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/symbols.c mc-xemacs-21.5/src/symbols.c --- xemacs-21.5/src/symbols.c 2005-03-03 00:41:08.000000000 +0100 +++ mc-xemacs-21.5/src/symbols.c 2005-03-23 01:52:24.000000000 +0100 ＠＠ -2187,8 +2187,13 ＠＠ { struct symbol_value_buffer_local *bfwd +#ifdef MC_ALLOC + = alloc_lrecord_type (struct symbol_value_buffer_local, + &lrecord_symbol_value_buffer_local); +#else /* not MC_ALLOC */ = alloc_lcrecord_type (struct symbol_value_buffer_local, &lrecord_symbol_value_buffer_local); +#endif /* not MC_ALLOC */ Lisp_Object foo; bfwd->magic.type = SYMVAL_BUFFER_LOCAL; ＠＠ -2295,8 +2300,13 ＠＠ } /* Make sure variable is set up to hold per-buffer values */ +#ifdef MC_ALLOC + bfwd = alloc_lrecord_type (struct symbol_value_buffer_local, + &lrecord_symbol_value_buffer_local); +#else /* not MC_ALLOC */ bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local, &lrecord_symbol_value_buffer_local); +#endif /* not MC_ALLOC */ bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL; bfwd->current_buffer = Qnil; ＠＠ -3015,8 +3025,13 ＠＠ valcontents = XSYMBOL (variable)->value; if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents)) { +#ifdef MC_ALLOC + bfwd = alloc_lrecord_type (struct symbol_value_lisp_magic, + &lrecord_symbol_value_lisp_magic); +#else /* MC_ALLOC */ bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic, &lrecord_symbol_value_lisp_magic); +#endif /* not MC_ALLOC */ bfwd->magic.type = SYMVAL_LISP_MAGIC; for (i = 0; i < MAGIC_HANDLER_MAX; i++) { ＠＠ -3151,8 +3166,13 ＠＠ invalid_change ("Variable is magic and cannot be aliased", variable); reject_constant_symbols (variable, Qunbound, 0, Qt); +#ifdef MC_ALLOC + bfwd = alloc_lrecord_type (struct symbol_value_varalias, + &lrecord_symbol_value_varalias); +#else /* not MC_ALLOC */ bfwd = alloc_lcrecord_type (struct symbol_value_varalias, &lrecord_symbol_value_varalias); +#endif /* not MC_ALLOC */ bfwd->magic.type = SYMVAL_VARALIAS; bfwd->aliasee = alias; bfwd->shadowed = valcontents; ＠＠ -3252,6 +3272,7 ＠＠ Lisp_Object Qnull_pointer; #endif +#ifndef MC_ALLOC /* some losing systems can't have static vars at function scope... */ static const struct symbol_value_magic guts_of_unbound_marker = { /* struct symbol_value_magic */ ＠＠ -3269,6 +3290,7 ＠＠ 0, /* value */ SYMVAL_UNBOUND_MARKER }; +#endif /* not MC_ALLOC */ void init_symbols_once_early (void) ＠＠ -3300,7 +3322,18 ＠＠ { /* Required to get around a GCC syntax error on certain architectures */ +#ifdef MC_ALLOC + struct symbol_value_magic *tem = (struct symbol_value_magic *) + mc_alloc (sizeof (struct symbol_value_magic)); + MARK_LRECORD_AS_LISP_READONLY (tem); + MARK_LRECORD_AS_NOT_FREE (tem); + tem->header.type = lrecord_type_symbol_value_forward; + mcpro (wrap_pointer_1 (tem)); + tem->value = 0; + tem->type = SYMVAL_UNBOUND_MARKER; +#else /* not MC_ALLOC */ const struct symbol_value_magic *tem = &guts_of_unbound_marker; +#endif /* not MC_ALLOC */ Qunbound = wrap_symbol_value_magic (tem); } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/symeval.h mc-xemacs-21.5/src/symeval.h --- xemacs-21.5/src/symeval.h 2005-03-03 00:41:08.000000000 +0100 +++ mc-xemacs-21.5/src/symeval.h 2005-03-23 01:52:46.000000000 +0100 ＠＠ -77,7 +77,11 ＠＠ struct symbol_value_magic { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header lcheader; +#endif /* MC_ALLOC */ void *value; enum symbol_value_type type; }; ＠＠ -277,6 +281,44 ＠＠ DEFUN ("name, Fname, ...); // at top level in foo.c DEFSUBR (Fname); // in syms_of_foo(); */ +#ifdef MC_ALLOC +MODULE_API void defsubr (Lisp_Subr *); +#define DEFSUBR_MC_ALLOC(Fname) \ + struct Lisp_Subr *S##Fname= (struct Lisp_Subr *) \ + mc_alloc (sizeof (struct Lisp_Subr)); \ + set_lheader_implementation (&S##Fname->lheader, &lrecord_subr); \ + \ + S##Fname->min_args = MC_ALLOC_S##Fname.min_args; \ + S##Fname->max_args = MC_ALLOC_S##Fname.max_args; \ + S##Fname->prompt = MC_ALLOC_S##Fname.prompt; \ + S##Fname->doc = MC_ALLOC_S##Fname.doc; \ + S##Fname->name = MC_ALLOC_S##Fname.name; \ + S##Fname->subr_fn = MC_ALLOC_S##Fname.subr_fn; \ + MARK_LRECORD_AS_LISP_READONLY (S##Fname); + + +#define DEFSUBR(Fname) \ +do { \ + DEFSUBR_MC_ALLOC (Fname); \ + defsubr (S##Fname); \ +} while (0) + +/* To define a Lisp primitive macro using a C function `Fname', do this: + DEFUN ("name, Fname, ...); // at top level in foo.c + DEFSUBR_MACRO (Fname); // in syms_of_foo(); +*/ +MODULE_API void defsubr_macro (Lisp_Subr *); +#define DEFSUBR_MACRO(Fname) \ +do { \ + DEFSUBR_MC_ALLOC (Fname); \ + defsubr_macro (S##Fname); \ +} while (0) + +#else /* not MC_ALLOC */ +/* To define a Lisp primitive function using a C function `Fname', do this: + DEFUN ("name, Fname, ...); // at top level in foo.c + DEFSUBR (Fname); // in syms_of_foo(); +*/ MODULE_API void defsubr (Lisp_Subr *); #define DEFSUBR(Fname) defsubr (&S##Fname) ＠＠ -286,6 +328,7 ＠＠ */ MODULE_API void defsubr_macro (Lisp_Subr *); #define DEFSUBR_MACRO(Fname) defsubr_macro (&S##Fname) +#endif /* not MC_ALLOC */ MODULE_API void defsymbol_massage_name (Lisp_Object *location, const char *name); ＠＠ -358,6 +401,24 ＠＠ MODULE_API void defvar_magic (const char *symbol_name, const struct symbol_value_forward *magic); +#ifdef MC_ALLOC +#define DEFVAR_SYMVAL_FWD(lname, c_location, 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);*/ \ + \ + MARK_LRECORD_AS_LISP_READONLY (I_hate_C); \ + \ + I_hate_C->magic.value = c_location; \ + I_hate_C->magic.type = forward_type; \ + I_hate_C->magicfun = magic_fun; \ + \ + defvar_magic ((lname), I_hate_C); \ +} while (0) +#else /* not MC_ALLOC */ #define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magicfun) \ do \ { \ ＠＠ -383,7 +444,7 ＠＠ }; \ defvar_magic ((lname), &I_hate_C); \ } while (0) - +#endif /* not MC_ALLOC */ #define DEFVAR_SYMVAL_FWD_INT(lname, c_location, forward_type, magicfun) \ do \ { \ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/symsinit.h mc-xemacs-21.5/src/symsinit.h --- xemacs-21.5/src/symsinit.h 2005-03-03 00:41:08.000000000 +0100 +++ mc-xemacs-21.5/src/symsinit.h 2005-03-21 12:10:47.000000000 +0100 ＠＠ -140,6 +140,9 ＠＠ void syms_of_lread (void); void syms_of_macros (void); void syms_of_marker (void); +#ifdef MC_ALLOC +void syms_of_mc_alloc (void); +#endif /* MC_ALLOC */ void syms_of_md5 (void); void syms_of_menubar (void); void syms_of_menubar_mswindows (void); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/tests.c mc-xemacs-21.5/src/tests.c --- xemacs-21.5/src/tests.c 2005-03-03 00:41:09.000000000 +0100 +++ mc-xemacs-21.5/src/tests.c 2005-02-01 22:58:22.000000000 +0100 ＠＠ -479,12 +479,22 ＠＠ +#ifdef MC_ALLOC +#define TESTS_DEFSUBR(Fname) do { \ + DEFSUBR_MC_ALLOC (Fname); \ + defsubr (S##Fname); \ + Vtest_function_list = \ + Fcons (intern (subr_name (S##Fname)), \ + Vtest_function_list); \ +} while (0) +#else /* not MC_ALLOC */ #define TESTS_DEFSUBR(Fname) do { \ DEFSUBR (Fname); \ Vtest_function_list = \ Fcons (intern (subr_name (&S##Fname)), \ Vtest_function_list); \ } while (0) +#endif /* not MC_ALLOC */ void syms_of_tests (void) diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/toolbar.c mc-xemacs-21.5/src/toolbar.c --- xemacs-21.5/src/toolbar.c 2005-03-03 00:41:10.000000000 +0100 +++ mc-xemacs-21.5/src/toolbar.c 2005-02-01 22:58:22.000000000 +0100 ＠＠ -303,7 +303,11 ＠＠ if (!tb) { +#ifdef MC_ALLOC + tb = alloc_lrecord_type (struct toolbar_button, &lrecord_toolbar_button); +#else /* not MC_ALLOC */ tb = alloc_lcrecord_type (struct toolbar_button, &lrecord_toolbar_button); +#endif /* not MC_ALLOC */ tb->next = Qnil; tb->frame = wrap_frame (f); tb->up_glyph = Qnil; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/toolbar.h mc-xemacs-21.5/src/toolbar.h --- xemacs-21.5/src/toolbar.h 2005-03-03 00:41:10.000000000 +0100 +++ mc-xemacs-21.5/src/toolbar.h 2005-02-01 22:58:22.000000000 +0100 ＠＠ -38,7 +38,11 ＠＠ struct toolbar_button { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object next; Lisp_Object frame; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/tooltalk.c mc-xemacs-21.5/src/tooltalk.c --- xemacs-21.5/src/tooltalk.c 2005-03-03 00:41:10.000000000 +0100 +++ mc-xemacs-21.5/src/tooltalk.c 2005-02-01 22:58:22.000000000 +0100 ＠＠ -147,7 +147,11 ＠＠ struct Lisp_Tooltalk_Message { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object plist_sym, callback; Tt_message m; }; ＠＠ -191,7 +195,11 ＠＠ { Lisp_Object val; Lisp_Tooltalk_Message *msg = +#ifdef MC_ALLOC + alloc_lrecord_type (Lisp_Tooltalk_Message, &lrecord_tooltalk_message); +#else /* not MC_ALLOC */ alloc_lcrecord_type (Lisp_Tooltalk_Message, &lrecord_tooltalk_message); +#endif /* not MC_ALLOC */ msg->m = m; msg->callback = Qnil; ＠＠ -225,7 +233,11 ＠＠ struct Lisp_Tooltalk_Pattern { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ Lisp_Object plist_sym, callback; Tt_pattern p; }; ＠＠ -268,7 +280,11 ＠＠ make_tooltalk_pattern (Tt_pattern p) { Lisp_Tooltalk_Pattern *pat = +#ifdef MC_ALLOC + alloc_lrecord_type (Lisp_Tooltalk_Pattern, &lrecord_tooltalk_pattern); +#else /* not MC_ALLOC */ alloc_lcrecord_type (Lisp_Tooltalk_Pattern, &lrecord_tooltalk_pattern); +#endif /* not MC_ALLOC */ Lisp_Object val; pat->p = p; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/ui-gtk.c mc-xemacs-21.5/src/ui-gtk.c --- xemacs-21.5/src/ui-gtk.c 2005-03-03 00:41:10.000000000 +0100 +++ mc-xemacs-21.5/src/ui-gtk.c 2005-02-01 22:58:27.000000000 +0100 ＠＠ -280,7 +280,11 ＠＠ static emacs_ffi_data * allocate_ffi_data (void) { +#ifdef MC_ALLOC + emacs_ffi_data *data = alloc_lrecord_type (emacs_ffi_data, &lrecord_emacs_ffi); +#else /* not MC_ALLOC */ emacs_ffi_data *data = alloc_lcrecord_type (emacs_ffi_data, &lrecord_emacs_ffi); +#endif /* not MC_ALLOC */ data->return_type = GTK_TYPE_NONE; data->n_args = 0; ＠＠ -944,8 +948,13 ＠＠ static emacs_gtk_object_data * allocate_emacs_gtk_object_data (void) { +#ifdef MC_ALLOC + emacs_gtk_object_data *data = alloc_lrecord_type (emacs_gtk_object_data, + &lrecord_emacs_gtk_object); +#else /* not MC_ALLOC */ emacs_gtk_object_data *data = alloc_lcrecord_type (emacs_gtk_object_data, &lrecord_emacs_gtk_object); +#endif /* not MC_ALLOC */ data->object = NULL; data->alive_p = FALSE; ＠＠ -1153,8 +1162,13 ＠＠ static emacs_gtk_boxed_data * allocate_emacs_gtk_boxed_data (void) { +#ifdef MC_ALLOC + emacs_gtk_boxed_data *data = alloc_lrecord_type (emacs_gtk_boxed_data, + &lrecord_emacs_gtk_boxed); +#else /* not MC_ALLOC */ emacs_gtk_boxed_data *data = alloc_lcrecord_type (emacs_gtk_boxed_data, &lrecord_emacs_gtk_boxed); +#endif /* not MC_ALLOC */ data->object = NULL; data->object_type = GTK_TYPE_INVALID; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/ui-gtk.h mc-xemacs-21.5/src/ui-gtk.h --- xemacs-21.5/src/ui-gtk.h 2005-03-03 00:41:10.000000000 +0100 +++ mc-xemacs-21.5/src/ui-gtk.h 2005-02-01 22:58:27.000000000 +0100 ＠＠ -21,7 +21,11 ＠＠ #define MAX_GTK_ARGS 100 typedef struct { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ GtkType return_type; GtkType args[MAX_GTK_ARGS]; gint n_args; ＠＠ -39,7 +43,11 ＠＠ /* Encapsulate a GtkObject in Lisp */ typedef struct { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ gboolean alive_p; GtkObject *object; Lisp_Object plist; ＠＠ -56,7 +64,11 ＠＠ /* Encapsulate a GTK_TYPE_BOXED in lisp */ typedef struct { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ GtkType object_type; void *object; } emacs_gtk_boxed_data; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/unicode.c mc-xemacs-21.5/src/unicode.c --- xemacs-21.5/src/unicode.c 2005-04-01 20:32:38.000000000 +0200 +++ mc-xemacs-21.5/src/unicode.c 2005-04-01 20:26:37.000000000 +0200 ＠＠ -548,10 +548,15 ＠＠ } } +#ifdef MC_ALLOC + size += mc_alloced_storage_size (256 * (level == 1 ? sizeof (short) : + sizeof (void *)), stats); +#else /* not MC_ALLOC */ size += malloced_storage_size (table, 256 * (level == 1 ? sizeof (short) : sizeof (void *)), stats); +#endif /* not MC_ALLOC */ return size; } ＠＠ -573,10 +578,15 ＠＠ } } +#ifdef MC_ALLOC + size += mc_alloced_storage_size (96 * (level == 1 ? sizeof (int) : + sizeof (void *)), stats); +#else /* not MC_ALLOC */ size += malloced_storage_size (table, 96 * (level == 1 ? sizeof (int) : sizeof (void *)), stats); +#endif /* not MC_ALLOC */ return size; } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/window.c mc-xemacs-21.5/src/window.c --- xemacs-21.5/src/window.c 2005-03-03 00:41:12.000000000 +0100 +++ mc-xemacs-21.5/src/window.c 2005-03-19 00:52:18.000000000 +0100 ＠＠ -346,7 +346,11 ＠＠ Lisp_Object allocate_window (void) { +#ifdef MC_ALLOC + struct window *p = alloc_lrecord_type (struct window, &lrecord_window); +#else /* not MC_ALLOC */ struct window *p = alloc_lcrecord_type (struct window, &lrecord_window); +#endif /* not MC_ALLOC */ Lisp_Object val = wrap_window (p); #define WINDOW_SLOT(slot) p->slot = Qnil; ＠＠ -483,7 +487,11 ＠＠ new_window_mirror (struct frame *f) { struct window_mirror *t = +#ifdef MC_ALLOC + alloc_lrecord_type (struct window_mirror, &lrecord_window_mirror); +#else /* not MC_ALLOC */ alloc_lcrecord_type (struct window_mirror, &lrecord_window_mirror); +#endif /* not MC_ALLOC */ t->frame = f; t->current_display_lines = Dynarr_new (display_line); ＠＠ -3802,10 +3810,18 ＠＠ { Lisp_Object new; struct window *o = XWINDOW (window); +#ifdef MC_ALLOC + struct window *p = alloc_lrecord_type (struct window, &lrecord_window); +#else /* not MC_ALLOC */ struct window *p = alloc_lcrecord_type (struct window, &lrecord_window); +#endif /* not MC_ALLOC */ new = wrap_window (p); +#ifdef MC_ALLOC + copy_lrecord (p, o); +#else /* MC_ALLOC */ copy_lcrecord (p, o); +#endif /* MC_ALLOC */ /* Don't copy the pointers to the line start cache or the face instances. */ ＠＠ -5096,8 +5112,13 ＠＠ { if (!mir) return; +#ifdef MC_ALLOC + stats->other += mc_alloced_storage_size (sizeof (struct window_mirror), + ovstats); +#else /* not MC_ALLOC */ stats->other += malloced_storage_size (mir, sizeof (struct window_mirror), ovstats); +#endif /* not MC_ALLOC */ #ifdef HAVE_SCROLLBARS { struct device *d = XDEVICE (FRAME_DEVICE (mir->frame)); ＠＠ -5121,7 +5142,11 ＠＠ struct overhead_stats *ovstats) { xzero (*stats); +#ifdef MC_ALLOC + stats->other += mc_alloced_storage_size (sizeof (struct window), ovstats); +#else /* not MC_ALLOC */ stats->other += malloced_storage_size (w, sizeof (struct window), ovstats); +#endif /* not MC_ALLOC */ stats->face += compute_face_cachel_usage (w->face_cachels, ovstats); stats->glyph += compute_glyph_cachel_usage (w->glyph_cachels, ovstats); stats->line_start += diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/window-impl.h mc-xemacs-21.5/src/window-impl.h --- xemacs-21.5/src/window-impl.h 2005-03-03 00:41:12.000000000 +0100 +++ mc-xemacs-21.5/src/window-impl.h 2005-02-01 22:58:27.000000000 +0100 ＠＠ -84,7 +84,11 ＠＠ struct window { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ /* The upper left corner coordinates of this window, as integers (pixels) relative to upper left corner of frame = 0, 0 */ ＠＠ -168,7 +172,11 ＠＠ struct window_mirror { +#ifdef MC_ALLOC + struct lrecord_header header; +#else /* MC_ALLOC */ struct lcrecord_header header; +#endif /* MC_ALLOC */ /* Frame this mirror is on. */ struct frame *frame; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/xemacs.def.in.in mc-xemacs-21.5/src/xemacs.def.in.in --- xemacs-21.5/src/xemacs.def.in.in 2005-03-19 02:59:58.000000000 +0100 +++ mc-xemacs-21.5/src/xemacs.def.in.in 2005-02-01 22:58:22.000000000 +0100 ＠＠ -9,7 +9,17 ＠＠ EXPORTS /* Exported functions */ acons +#ifdef MC_ALLOC +alloc_lrecord /* alloc_lrecord_type */ +lrecord_subr /* DEFSUBR */ +lrecord_symbol_value_forward /* DEFVAR_SYMVAL_FWD */ +#ifdef DEBUG_XEMACS +mcpro_1 /* mcpro */ +#endif +mc_allocate /* DEFSUBR */ +#else /* not MC_ALLOC */ alloc_automanaged_lcrecord /* alloc_lcrecord_type */ +#endif /* not MC_ALLOC */ apply1 #ifdef USE_ASSERTIONS assert_failed /* abort(), assert(), etc. */ -- Marcus

1 participants
0 comments

[PATCH] (text.c) move active code out from assert() 19 years, 8 months

Melvin Hadasht

Hi, If xemacs is compiled with --disable-debug it crashes due to not compiled active code in an assert() call. The following patch moves the call out from the assert(). Cheers.

1 participants
0 comments

[COMMIT] [sjt-xft] Make the debug messages mule clean, treat FC font names as UTF-8 19 years, 8 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed. Giacomo, this should make the crash you were seeing on startup go away. Font names and foundries in fontconfig are always UTF-8--see FcFreeTypeQuery, in fcfreetype.c, for where it does this conversion. I don’t believe this is documented anywhere, but accepting this is the only way to get sane non-ASCII font name behaviour. Unfortunately, the madly verbose version of the font specification with full character coverage information as a bitmap, which we have been using up to this point, can’t be interpreted as UTF-8. So, we use a slightly less verbose font spec instead. src/ChangeLog addition: 2005-04-01 Aidan Kehoe <kehoea(a)parhasard.net> * objects-x.c: * objects-x.c (x_initialize_font_instance): * objects-x.c (CHECKING_LANG): General mule-sanity cleanup for the debug messages, to eliminate the issue Giacomo Boffi saw in 16970.44359.621213.994821(a)boffi95.stru.polimi.it. * objects-x.c (x_find_charset_font): Font names are also treated as UTF-8; relatedly, when passing back the font's full name, the character coverage bitmap isn't included any more, because that would make it an invalid UTF-8 string. XEmacs sjt-xft source patch: Diff command: cvs -q diff -u Files affected: src/objects-x.c Index: src/objects-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v retrieving revision 1.26.2.15 diff -u -u -r1.26.2.15 objects-x.c --- src/objects-x.c 2005/03/15 05:24:35 1.26.2.15 +++ src/objects-x.c 2005/04/01 00:18:16 ＠＠ -221,7 +221,8 ＠＠ #ifdef USE_XFT if (debug_xft > 2) - stderr_out ("attempting to initialize font spec %s\n", extname); + stderr_out ("attempting to initialize font spec %s\n", + XSTRING_DATA(f->name)); /* #### serialize (optimize) these later... */ /* #### This function really needs to go away. The problem is that the fontconfig/Xft functions work much too hard ＠＠ -288,13 +289,15 ＠＠ stderr_out ("initialized metrics ascent %d descent %d width %d height %d\n", f->ascent, f->descent, f->width, f->height); if (debug_xft > 2) /* we also output on initialization of any font below */ - stderr_out ("initialized Xft font %s\n", extname); + stderr_out ("initialized Xft font %s\n", + XSTRING_DATA(f->name)); fs = NULL; /* we don' need no steenkin' X font */ } else { if (debug_xft > 0) - stderr_out ("couldn't initialize Xft font %s\n", extname); + stderr_out ("couldn't initialize Xft font %s\n", + XSTRING_DATA(f->name)); } #endif ＠＠ -369,11 +372,11 ＠＠ /* #### check for weirdness */ if (n * f->height < d * f->width) stderr_out ("font %s: width:height is %d:%d, larger than %d:%d\n", - extname, f->width, f->height, n, d); + XSTRING_DATA(f->name), f->width, f->height, n, d); if (f->height <= 0 || f->width <= 0) stderr_out ("bogus dimensions of font %s: width = %d, height = %d\n", - extname, f->width, f->height); - stderr_out ("initialized font %s\n", extname); + XSTRING_DATA(f->name), f->width, f->height); + stderr_out ("initialized font %s\n", XSTRING_DATA(f->name)); } #else #undef rf ＠＠ -1114,12 +1117,19 ＠＠ /* print an Xft pattern to stderr LEVEL is the debug level (to compare to debug_xft) FORMAT is a newline-terminated printf format with one %s for the pattern - PATTERN is an FcPattern *. */ -#define PRINT_XFT_PATTERN(level,format,pattern) \ - do { \ - FcChar8 *name = FcNameUnparse (pattern); \ - DEBUG_XFT1 (level, format, name); \ - free (name); \ + PATTERN is an FcPattern *. + + Qbinary is the only coding system that's appropriate; while the font + names themselves are UTF-8, the coverage information is a pure bitmap + that won't be in any valid multibyte encoding. */ +#define PRINT_XFT_PATTERN(level,format,pattern) \ + do { \ + DECLARE_EISTRING (eistrpxft_name); \ + FcChar8 *name = FcNameUnparse (pattern); \ + \ + eicpy_ext(eistrpxft_name, name, Qbinary); \ + DEBUG_XFT1 (level, format, eidata(eistrpxft_name)); \ + free (name); \ } while (0) /* print a progress message ＠＠ -1127,8 +1137,13 ＠＠ FORMAT is a newline-terminated printf format with two %s for font and lang FONT is the Xft font LANG is the language being checked for support. */ -#define CHECKING_LANG(level,font,lang) \ - DEBUG_XFT2 (level, "checking if %s handles %s\n", font, lang) +#define CHECKING_LANG(level,font,lang) \ + do { \ + DECLARE_EISTRING (eistrcl_name); \ + eicpy_ext(eistrcl_name, font, Qbinary); \ + DEBUG_XFT2 (level, "checking if %s handles %s\n", \ + eidata(eistrcl_name), lang); \ + } while (0) struct charset_reporter { Lisp_Object *charset; ＠＠ -1195,10 +1210,14 ＠＠ return Qnil; #ifdef USE_XFT - /* #### does Xft permit/require a different encoding? */ - LISP_STRING_TO_EXTERNAL (font, patternext, Qx_font_name_encoding); + /* Fontconfig converts all strings to UTF-8 before passing them back to + callers--see FcFreeTypeQuery, in fcfreetype.c, for where it does + this. I don't believe this is documented. */ + + LISP_STRING_TO_EXTERNAL (font, patternext, Qutf_8); - DEBUG_XFT1 (1, "confirming charset for font instance %s\n", patternext); + DEBUG_XFT1 (1, "confirming charset for font instance %s\n", + XSTRING_DATA(font)); /* #### this looks like a fair amount of work, but the basic design has never been rethought, and it should be ＠＠ -1216,9 +1235,11 ＠＠ FcChar8 *lang = "en"; FcCharSet *fccs = NULL; FcChar8 *shortname; + DECLARE_EISTRING (eistr_shortname); fcc = FcConfigGetCurrent (); patternxft = FcNameParse (patternext); /* #### needs freeing */ + PRINT_XFT_PATTERN (1,"FcNameParse'ed name is %s\n",patternxft); /* #### Next two return FcBool, but what does the return mean? */ /* The order is correct according the fontconfig docs. */ ＠＠ -1236,6 +1257,8 ＠＠ FcPatternDel (p, FC_LANG); shortname = FcNameUnparse (p); /* #### needs freeing */ FcPatternDestroy (p); + eicpy_ext(eistr_shortname, shortname, Qutf_8); + free(shortname); } /* The language approach may better in the long run, but we can't use ＠＠ -1254,7 +1277,7 ＠＠ if (cr->rfc3066) { - CHECKING_LANG (0, shortname, cr->language); + CHECKING_LANG (0, eidata(eistr_shortname), cr->language); lang = cr->rfc3066; } else if (cr->charset) ＠＠ -1275,6 +1298,8 ＠＠ /* default to "en" */ } + ASSERT_ASCTEXT_ASCII(lang); + if (fccs) { /* check for character set coverage */ ＠＠ -1285,6 +1310,7 ＠＠ if (r == FcResultTypeMismatch) { + free(patternxft); /* Urk! Fall back and punt to core font. */ DEBUG_XFT0 (0, "Unexpected type return in charset value\n"); /* uncomment this to not try core font */ ＠＠ -1292,14 +1318,43 ＠＠ } else if (r == FcResultMatch && FcCharSetIsSubset (fccs, v)) { - DEBUG_XFT2 (0, "Xft font %s supports %s\n", shortname, lang); - /* #### would it be better to return shortname? */ - retval = (build_string (FcNameUnparse (patternxft))); + FcChar8 *unparsed = FcNameUnparse(patternxft); + DECLARE_EISTRING (eistr_longname); + +#ifdef __GNUC__ +#warning "Perhaps the shortname won't identify the font uniquely--see comment." +#endif + /* If we're going to use the full font name above, we can't + treat it as any other encoding than Qbinary, because the + bitmap of character coverage which forms part of it gives + no guarantees that it'll encode as anything else. + + However, fontconfig returns foundry and name information in + UTF-8. So the shortname above will better correspond to the + font's name, because we can treat it as valid UTF-8, and + non-ASCII characters will show up properly as Mule + characters. + + So, in the interest of getting XEmacs' font selection + almost coherent, I'm passing back the short name, as a Lisp + String, decoded from UTF-8. */ + + eicpy_ext(eistr_longname, unparsed, Qbinary); + free(unparsed); + free(patternxft); + + DEBUG_XFT2 (0, "Xft font, full specification, %s supports %s\n", + eidata(eistr_longname), lang); + DEBUG_XFT1 (0, "We're returning the short specification %s, in the interest of preserving the encoding of the font's name. ", + eidata(eistr_shortname)); + + retval = eimake_string(eistr_shortname); } else { + free(patternxft); DEBUG_XFT2 (0, "Xft font %s doesn't support %s\n", - shortname, lang); + eidata(eistr_shortname), lang); /* comment this to try the core font */ retval = Qnil; } ＠＠ -1316,10 +1371,13 ＠＠ FcValue v; /* the main event */ FcResult r = FcPatternGet (patternxft, FC_LANG, i, &v); + /* Not using patternxft beyond here. */ + if (r == FcResultMatch) { if (v.type != FcTypeLangSet) /* excessive paranoia */ { + ASSERT_ASCTEXT_ASCII(FcTypeOfValueToString(v)); /* Urk! Fall back and punt to core font. */ DEBUG_XFT1 (0, "Unexpected type of lang value (%s)\n", FcTypeOfValueToString (v)); ＠＠ -1328,23 +1386,32 ＠＠ } else if (FcLangSetHasLang (v.u.l, lang) != FcLangDifferentLang) { - DEBUG_XFT2 (0, "Xft font %s supports %s\n", shortname, lang); - /* #### would it be better to return shortname? */ - return (build_string (FcNameUnparse (patternxft))); + DEBUG_XFT2 (0, "Xft font %s supports %s\n", + eidata(eistr_shortname), lang); + free(patternxft); + /* #### would it be better to return shortname? + + Aidan says yes. The full pattern with the bitmap + coverage is massively unwieldy. */ + + return eimake_string(eistr_shortname); } else { DEBUG_XFT2 (0, "Xft font %s doesn't support %s\n", - shortname, lang); + eidata(eistr_shortname), lang); return Qnil; } } + ASSERT_ASCTEXT_ASCII(FcResultToString(r)); DEBUG_XFT1 (0, "Unexpected result getting lang=%s\n", FcResultToString (r)); + free(patternxft); } } - DEBUG_XFT1 (0, "shit happens, try X11 charset match for %s\n", patternext); + DEBUG_XFT1 (0, "shit happens, try X11 charset match for %s\n", + XSTRING_DATA(font)); #endif /* USE_XFT */ names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)), -- “I, for instance, am gung-ho about open source because my family is being held hostage in Rob Malda’s basement. But who fact-checks me, or Enderle, when we say something in public? No-one!” -- Danny O’Brien

1 participants
0 comments

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

XEmacs-Patches April 2005