CVS update by viteno xemacs-builds/viteno ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: viteno
Date: 05/11/25 10:09:08
Modified: xemacs-builds/viteno package-index setup-packages.ini
Log:
Package database backup:
- ediff-1.59
- edit-utils-2.31
- viper-1.47
Revision Changes Path
1.263 +21 -21 XEmacs/xemacs-builds/viteno/package-index
Index: package-index
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs-builds/viteno/package-index,v
retrieving revision 1.262
retrieving revision 1.263
diff -u -p -r1.262 -r1.263
--- package-index 2005/11/21 07:56:07 1.262
+++ package-index 2005/11/25 09:09:07 1.263
＠＠ -789,19 +789,19 ＠＠
(package-get-update-base-entry (quote
(edit-utils
(standards-version 1.1
- version "2.30"
+ version "2.31"
author-version "No-Upstream-Ver"
- date "2005-11-21"
- build-date "2005-11-21"
+ date "2005-11-25"
+ build-date "2005-11-25"
maintainer "XEmacs Development Team <xemacs-beta(a)xemacs.org>"
distribution xemacs
priority high
category "standard"
dump nil
description "Miscellaneous editor extensions, you probably need this."
- filename "edit-utils-2.30-pkg.tar.gz"
- md5sum "2e80b10a989834108fbf5ef67472655d"
- size 934695
+ filename "edit-utils-2.31-pkg.tar.gz"
+ md5sum "0ed9c6f5009d9606a4f9841dc3a4b30d"
+ size 944605
provides (abbrevlist after-save-commands atomic-extents avoid backup-dir balloon-help big-menubar blink-cursor blink-paren bookmark compare-w completion dabbrev desktop detached-minibuf edit-toolbar fast-lock file-part floating-toolbar flow-ctrl foldout func-menu hippie-exp icomplete id-select info-look iswitchb lazy-lock lazy-shot live-icon makesum man mic-paren paren mode-motion+ outl-mouse outln-18 page-ext blink-paren paren permanent-buffers popper power-macros recent-files redo reportmail resume rsz-minibuf saveconf savehist saveplace scroll-in-place setnu shell-font tempo toolbar-utils tree-menu uniquify vertical-mode where-was-i-db winring autorevert align allout outline narrow-stack highline)
requires (xemacs-base xemacs-devel fsf-compat dired mail-lib)
type single
＠＠ -1581,19 +1581,19 ＠＠
(package-get-update-base-entry (quote
(viper
(standards-version 1.1
- version "1.46"
+ version "1.47"
author-version "3.09"
- date "2005-11-16"
- build-date "2005-11-16"
+ date "2005-11-25"
+ build-date "2005-11-25"
maintainer "Michael Kifer <kifer(a)cs.sunysb.edu>"
distribution xemacs
priority low
category "standard"
dump nil
description "VI emulation support."
- filename "viper-1.46-pkg.tar.gz"
- md5sum "e7f1ded79c43ee94ebb8c780572ba4f3"
- size 334931
+ filename "viper-1.47-pkg.tar.gz"
+ md5sum "66e3556c2421cf81083406bc92ad9f88"
+ size 335017
provides (viper-cmd viper-ex viper-init viper-keym viper-macs viper-mous viper-util viper)
requires (xemacs-base)
type regular
＠＠ -1738,7 +1738,7 ＠＠
version "1.46"
author-version "11.55"
date "2005-02-12"
- build-date "2005-02-12"
+ build-date "2005-11-22"
maintainer "Uwe Brauer <oub(a)mat.ucm.es>"
distribution xemacs
priority medium
＠＠ -1746,8 +1746,8 ＠＠
dump nil
description "Basic TeX/LaTeX support."
filename "auctex-1.46-pkg.tar.gz"
- md5sum "63b795e9ee4773d4220bf7c84295ff5e"
- size 709415
+ md5sum "5fd90caa65342e6afea5c50f46938fb5"
+ size 709284
provides (auc-old auc-tex bib-cite font-latex latex multi-prompt tex-buf tex-info tex-jp tex-mik tex-site tex texmathp hilit-LaTeX tex-font tex-fptex)
requires (xemacs-base)
type regular
＠＠ -1955,19 +1955,19 ＠＠
(package-get-update-base-entry (quote
(ediff
(standards-version 1.1
- version "1.58"
+ version "1.59"
author-version "2.75"
- date "2005-11-16"
- build-date "2005-11-16"
+ date "2005-11-25"
+ build-date "2005-11-25"
maintainer "Michael Kifer <kifer(a)cs.sunysb.edu>"
distribution xemacs
priority medium
category "standard"
dump nil
description "Interface over GNU patch."
- filename "ediff-1.58-pkg.tar.gz"
- md5sum "b5e6dfc0cab30974bc3686e136cf2cf3"
- size 313930
+ filename "ediff-1.59-pkg.tar.gz"
+ md5sum "01abed5a49c99c41cbcc22c5b9414afe"
+ size 313940
provides (ediff-diff ediff-help ediff-hook ediff-init ediff-merg ediff-mult ediff-ptch ediff-tbar ediff-util ediff-vers ediff-wind ediff)
requires (pcl-cvs elib dired xemacs-base edebug prog-modes)
type regular
1.251 +7 -7 XEmacs/xemacs-builds/viteno/setup-packages.ini
Index: setup-packages.ini
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs-builds/viteno/setup-packages.ini,v
retrieving revision 1.250
retrieving revision 1.251
diff -u -p -r1.250 -r1.251
--- setup-packages.ini 2005/11/21 07:56:07 1.250
+++ setup-packages.ini 2005/11/25 09:09:07 1.251
＠＠ -140,8 +140,8 ＠＠ version: 1.17
install: packages/debug-1.17-pkg.tar.gz 108073
＠ ediff
-version: 1.58
-install: packages/ediff-1.58-pkg.tar.gz 313930
+version: 1.59
+install: packages/ediff-1.59-pkg.tar.gz 313940
＠ emerge
version: 1.11
＠＠ -181,7 +181,7 ＠＠ install: packages/vhdl-1.20-pkg.tar.gz 3
＠ auctex
version: 1.46
-install: packages/auctex-1.46-pkg.tar.gz 709415
+install: packages/auctex-1.46-pkg.tar.gz 709284
＠ crisp
version: 1.15
＠＠ -208,8 +208,8 ＠＠ version: 1.14
install: packages/tpu-1.14-pkg.tar.gz 59529
＠ viper
-version: 1.46
-install: packages/viper-1.46-pkg.tar.gz 334931
+version: 1.47
+install: packages/viper-1.47-pkg.tar.gz 335017
＠ eterm
version: 1.17
＠＠ -320,8 +320,8 ＠＠ version: 1.11
install: packages/ps-print-1.11-pkg.tar.gz 156222
＠ edit-utils
-version: 2.30
-install: packages/edit-utils-2.30-pkg.tar.gz 934695
+version: 2.31
+install: packages/edit-utils-2.31-pkg.tar.gz 944605
＠ fsf-compat
version: 1.15
- 1 participants
- 0 comments
CVS update by viteno packages/xemacs-packages/viper ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: viteno
Date: 05/11/25 09:15:38
Modified: packages/xemacs-packages/viper ChangeLog Makefile
Log:
Increment VERSION in Makefile
Revision Changes Path
1.71 +4 -0 XEmacs/packages/xemacs-packages/viper/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/viper/ChangeLog,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -p -r1.70 -r1.71
--- ChangeLog 2005/11/25 07:20:46 1.70
+++ ChangeLog 2005/11/25 08:15:37 1.71
＠＠ -1,3 +1,7 ＠＠
+2005-11-25 Norbert Koch <viteno(a)xemacs.org>
+
+ * Makefile (VERSION): XEmacs package 1.47 released.
+
2005-11-25 Michael Kifer <kifer(a)cs.stonybrook.edu>
* viper-keym.el (viper-ESC-key): use different values in terminal and
1.55 +1 -1 XEmacs/packages/xemacs-packages/viper/Makefile
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/viper/Makefile,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -p -r1.54 -r1.55
--- Makefile 2005/11/16 07:53:18 1.54
+++ Makefile 2005/11/25 08:15:37 1.55
＠＠ -17,7 +17,7 ＠＠
# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
-VERSION = 1.46
+VERSION = 1.47
AUTHOR_VERSION = 3.09
MAINTAINER = Michael Kifer <kifer(a)cs.sunysb.edu>
PACKAGE = viper
- 1 participants
- 0 comments
CVS update by viteno packages/xemacs-packages/edit-utils ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: viteno
Date: 05/11/25 09:15:15
Modified: packages/xemacs-packages/edit-utils ChangeLog Makefile
Log:
Increment VERSION in Makefile
Revision Changes Path
1.214 +4 -0 XEmacs/packages/xemacs-packages/edit-utils/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/edit-utils/ChangeLog,v
retrieving revision 1.213
retrieving revision 1.214
diff -u -p -r1.213 -r1.214
--- ChangeLog 2005/11/21 07:59:42 1.213
+++ ChangeLog 2005/11/25 08:15:15 1.214
＠＠ -1,3 +1,7 ＠＠
+2005-11-25 Norbert Koch <viteno(a)xemacs.org>
+
+ * Makefile (VERSION): XEmacs package 2.31 released.
+
2005-11-21 Adrian Aichner <adrian(a)xemacs.org>
* Makefile (ELCS): Add crm.elc.
1.144 +1 -1 XEmacs/packages/xemacs-packages/edit-utils/Makefile
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/edit-utils/Makefile,v
retrieving revision 1.143
retrieving revision 1.144
diff -u -p -r1.143 -r1.144
--- Makefile 2005/11/21 07:59:42 1.143
+++ Makefile 2005/11/25 08:15:15 1.144
＠＠ -19,7 +19,7 ＠＠
# This XEmacs package contains independent single file lisp packages
-VERSION = 2.30
+VERSION = 2.31
AUTHOR_VERSION =
MAINTAINER = XEmacs Development Team <xemacs-beta(a)xemacs.org>
PACKAGE = edit-utils
- 1 participants
- 0 comments
CVS update by viteno packages/xemacs-packages/ediff ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: viteno
Date: 05/11/25 09:14:43
Modified: packages/xemacs-packages/ediff ChangeLog Makefile
Log:
Increment VERSION in Makefile
Revision Changes Path
1.97 +4 -0 XEmacs/packages/xemacs-packages/ediff/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ediff/ChangeLog,v
retrieving revision 1.96
retrieving revision 1.97
diff -u -p -r1.96 -r1.97
--- ChangeLog 2005/11/25 07:31:38 1.96
+++ ChangeLog 2005/11/25 08:14:43 1.97
＠＠ -1,3 +1,7 ＠＠
+2005-11-25 Norbert Koch <viteno(a)xemacs.org>
+
+ * Makefile (VERSION): XEmacs package 1.59 released.
+
2005-11-25 Michael Kifer <kifer(a)cs.stonybrook.edu>
* ediff-wind (ediff-make-wide-display): Slight simplification.
1.71 +1 -1 XEmacs/packages/xemacs-packages/ediff/Makefile
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ediff/Makefile,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -p -r1.70 -r1.71
--- Makefile 2005/11/16 07:52:56 1.70
+++ Makefile 2005/11/25 08:14:43 1.71
＠＠ -17,7 +17,7 ＠＠
# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
-VERSION = 1.58
+VERSION = 1.59
AUTHOR_VERSION = 2.75
MAINTAINER = Michael Kifer <kifer(a)cs.sunysb.edu>
PACKAGE = ediff
- 1 participants
- 0 comments
CVS update by viteno packages ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: viteno
Date: 05/11/25 09:14:25
Modified: packages ChangeLog
Log:
Package release
Revision Changes Path
1.586 +4 -0 XEmacs/packages/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/ChangeLog,v
retrieving revision 1.585
retrieving revision 1.586
diff -u -p -r1.585 -r1.586
--- ChangeLog 2005/11/21 07:41:47 1.585
+++ ChangeLog 2005/11/25 08:14:25 1.586
＠＠ -1,3 +1,7 ＠＠
+2005-11-25 Norbert Koch <viteno(a)xemacs.org>
+
+ * Packages released: ediff edit-utils viper.
+
2005-11-21 Norbert Koch <viteno(a)xemacs.org>
* Packages released: edit-utils riece.
- 1 participants
- 0 comments
CVS update by michaelk packages/xemacs-packages/ediff, ChangeLog ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: michaelk
Date: 05/11/25 08:31:39
Modified: packages/xemacs-packages/ediff ediff.el ediff-wind.el
ChangeLog
Log:
* ediff-wind (ediff-make-wide-display): Slight simplification.
* ediff.el (ediff-date): Changed the date of last update.
Revision Changes Path
1.32 +1 -1 XEmacs/packages/xemacs-packages/ediff/ediff.el
Index: ediff.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ediff/ediff.el,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -p -r1.31 -r1.32
--- ediff.el 2005/10/06 00:17:44 1.31
+++ ediff.el 2005/11/25 07:31:38 1.32
＠＠ -8,7 +8,7 ＠＠
;; Keywords: comparing, merging, patching, tools, unix
(defconst ediff-version "2.80.1" "The current version of Ediff")
-(defconst ediff-date "October 5, 2005" "Date of last update")
+(defconst ediff-date "November 25, 2005" "Date of last update")
;; This file is part of GNU Emacs.
1.21 +1 -3 XEmacs/packages/xemacs-packages/ediff/ediff-wind.el
Index: ediff-wind.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ediff/ediff-wind.el,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -p -r1.20 -r1.21
--- ediff-wind.el 2005/10/06 00:17:44 1.20
+++ ediff-wind.el 2005/11/25 07:31:38 1.21
＠＠ -1135,9 +1135,7 ＠＠ It assumes that it is called from within
(list (cons 'left (max 0 (eval (cdr (assoc 'left frame-A-params)))))
(cons 'width (cdr (assoc 'width frame-A-params))))
ediff-wide-display-frame frame-A)
- (modify-frame-parameters frame-A (list (cons 'left cw)
- (cons 'width wd)))))
-
+ (modify-frame-parameters frame-A `((left . ,cw) (width . ,wd)))))
;; Revise the mode line to display which difference we have selected
1.96 +7 -1 XEmacs/packages/xemacs-packages/ediff/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ediff/ChangeLog,v
retrieving revision 1.95
retrieving revision 1.96
diff -u -p -r1.95 -r1.96
--- ChangeLog 2005/11/16 07:52:56 1.95
+++ ChangeLog 2005/11/25 07:31:38 1.96
＠＠ -1,7 +1,13 ＠＠
+2005-11-25 Michael Kifer <kifer(a)cs.stonybrook.edu>
+
+ * ediff-wind (ediff-make-wide-display): Slight simplification.
+
+ * ediff.el (ediff-date): Changed the date of last update.
+
2005-11-16 Norbert Koch <viteno(a)xemacs.org>
* Makefile (VERSION): XEmacs package 1.58 released.
-
+
2005-11-15 Michael Kifer <kifer(a)cs.stonybrook.edu>
* ediff-util (ediff-make-temp-file): use proper file-name-handler
- 1 participants
- 0 comments
CVS update by michaelk packages/xemacs-packages/viper, ChangeLog ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: michaelk
Date: 05/11/25 08:20:47
Modified: packages/xemacs-packages/viper viper.el viper-keym.el
ChangeLog
Log:
* viper-keym.el (viper-ESC-key): use different values in terminal and
window modes.
* viper.el (viper-emacs-state-mode-list): delete mail-mode, add
jde-javadoc-checker-report-mode.
Revision Changes Path
1.36 +3 -2 XEmacs/packages/xemacs-packages/viper/viper.el
Index: viper.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/viper/viper.el,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -p -r1.35 -r1.36
--- viper.el 2005/11/15 18:53:49 1.35
+++ viper.el 2005/11/25 07:20:46 1.36
＠＠ -9,7 +9,7 ＠＠
;; Author: Michael Kifer <kifer(a)cs.stonybrook.edu>
;; Keywords: emulations
-(defconst viper-version "3.11.5 of October 5, 2005"
+(defconst viper-version "3.11.5 of November 25, 2005"
"The current version of Viper")
;; This file is part of GNU Emacs.
＠＠ -429,7 +429,6 ＠＠ widget."
occur-mode
mh-folder-mode
- mail-mode
gnus-group-mode
gnus-summary-mode
＠＠ -441,6 +440,8 ＠＠ widget."
compilation-mode
rcirc-mode
+
+ jde-javadoc-checker-report-mode
view-mode
vm-mode
1.13 +3 -2 XEmacs/packages/xemacs-packages/viper/viper-keym.el
Index: viper-keym.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/viper/viper-keym.el,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -p -r1.12 -r1.13
--- viper-keym.el 2005/08/06 17:05:11 1.12
+++ viper-keym.el 2005/11/25 07:20:46 1.13
＠＠ -200,9 +200,10 ＠＠ Enter as a sexp. Examples: \"\\C-z\", [(
:type 'string
:group 'viper)
-(defcustom viper-ESC-key [(escape)] ; "\e"
+(defcustom viper-ESC-key (if (viper-window-display-p) [(escape)] "\e")
"Key used to ESC.
-Enter as a sexp. Examples: \"\\e\", [(escape)]."
+Enter as a sexp. Examples: \"\\e\", [(escape)].
+If running in a terminal, [(escape)] is not understood, so must use \"\\e\"."
:type 'sexp
:group 'viper
:set (lambda (symbol value)
1.70 +9 -1 XEmacs/packages/xemacs-packages/viper/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/viper/ChangeLog,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -p -r1.69 -r1.70
--- ChangeLog 2005/11/16 07:53:18 1.69
+++ ChangeLog 2005/11/25 07:20:46 1.70
＠＠ -1,7 +1,15 ＠＠
+2005-11-25 Michael Kifer <kifer(a)cs.stonybrook.edu>
+
+ * viper-keym.el (viper-ESC-key): use different values in terminal and
+ window modes.
+
+ * viper.el (viper-emacs-state-mode-list): delete mail-mode, add
+ jde-javadoc-checker-report-mode.
+
2005-11-16 Norbert Koch <viteno(a)xemacs.org>
* Makefile (VERSION): XEmacs package 1.46 released.
-
+
2005-11-15 Michael Kifer <kifer(a)cs.stonybrook.edu>
* viper-utils (viper-non-word-characters-reformed-vi): quote `-' in
- 1 participants
- 0 comments
CVS update by vins xemacs ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: vins
Date: 05/11/25 04:16:47
Branch: xemacs release-21-4
Modified: xemacs ChangeLog
Log:
Added ChangeLog entry to announce re-builder, xetla.
Revision Changes Path
1.241.2.78 +4 -0 XEmacs/xemacs/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/ChangeLog,v
retrieving revision 1.241.2.77
retrieving revision 1.241.2.78
diff -u -p -r1.241.2.77 -r1.241.2.78
--- ChangeLog 2005/11/25 01:59:59 1.241.2.77
+++ ChangeLog 2005/11/25 03:16:45 1.241.2.78
＠＠ -1,3 +1,7 ＠＠
+2005-04-11 Norbert Koch <viteno(a)xemacs.org>
+
+ * etc/PACKAGES: etc/PACKAGES: Announce re-builder, xetla.
+
2005-11-15 Dr. Volker Zell <Dr.Volker.Zell(a)oracle.com>
* configure.in: Avoid using Motif also for cygwin
- 1 participants
- 0 comments
CVS update by vins xemacs/src, database.c ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: vins
Date: 05/11/25 03:02:05
Branch: xemacs release-21-4
xemacs/etc release-21-4
xemacs/lisp release-21-4
xemacs/src release-21-4
Modified: xemacs/src ChangeLog callproc.c chartab.c config.h.in
database.c glyphs-gtk.c process-unix.c sysdll.c
Log:
More patches for 21.4.18.
Revision Changes Path
1.241.2.77 +13 -0 XEmacs/xemacs/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/ChangeLog,v
retrieving revision 1.241.2.76
retrieving revision 1.241.2.77
diff -u -p -r1.241.2.76 -r1.241.2.77
--- ChangeLog 2005/03/24 04:55:34 1.241.2.76
+++ ChangeLog 2005/11/25 01:59:59 1.241.2.77
＠＠ -1,3 +1,16 ＠＠
+2005-11-15 Dr. Volker Zell <Dr.Volker.Zell(a)oracle.com>
+
+ * configure.in: Avoid using Motif also for cygwin
+
+2005-11-15 Dr. Volker Zell <Dr.Volker.Zell(a)oracle.com>
+
+ * configure.in: Check for u_int*_t typedefs and use them in
+ Berkeley DB detection.
+
+2005-04-11 Norbert Koch <viteno(a)xemacs.org>
+
+ * etc/PACKAGES: etc/PACKAGES: Announce re-builder, xetla.
+
2005-03-23 Vin Shelton <acs(a)xemacs.org>
* configure.in: Remove -fno-gnu-linker option from Solaris
1.147.2.34 +238 -53 XEmacs/xemacs/configure
Index: configure
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/configure,v
retrieving revision 1.147.2.33
retrieving revision 1.147.2.34
diff -u -p -r1.147.2.33 -r1.147.2.34
--- configure 2005/03/24 04:55:35 1.147.2.33
+++ configure 2005/11/25 02:00:00 1.147.2.34
＠＠ -9657,7 +9657,7 ＠＠ rm -f conftest*
fi
case "$opsys" in
- *linux* ) lucid_prefers_motif="no" ;;
+ *linux* | cygwin* ) lucid_prefers_motif="no" ;;
* ) lucid_prefers_motif="yes" ;;
esac
＠＠ -14284,14 +14284,191 ＠＠ EOF
}
+echo $ac_n "checking for u_int8_t""... $ac_c" 1>&6
+echo "configure:14289: checking for u_int8_t" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 14292 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])u_int8_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_u_int8_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_u_int8_t=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_type_u_int8_t" 1>&6
+if test $ac_cv_type_u_int8_t = no; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining u_int8_t = uint8_t
+EOF
+cat >> confdefs.h <<\EOF
+#define u_int8_t uint8_t
+EOF
+}
+
+fi
+
+if test $ac_cv_type_u_int8_t = yes; then
+{ test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_U_INT8_T = 1
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_U_INT8_T 1
+EOF
+}
+
+fi
+echo $ac_n "checking for u_int16_t""... $ac_c" 1>&6
+echo "configure:14333: checking for u_int16_t" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 14336 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])u_int16_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_u_int16_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_u_int16_t=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_type_u_int16_t" 1>&6
+if test $ac_cv_type_u_int16_t = no; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining u_int16_t = uint16_t
+EOF
+cat >> confdefs.h <<\EOF
+#define u_int16_t uint16_t
+EOF
+}
+
+fi
+
+if test $ac_cv_type_u_int16_t = yes; then
+{ test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_U_INT16_T = 1
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_U_INT16_T 1
+EOF
+}
+
+fi
+echo $ac_n "checking for u_int32_t""... $ac_c" 1>&6
+echo "configure:14377: checking for u_int32_t" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 14380 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])u_int32_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_u_int32_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_u_int32_t=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_type_u_int32_t" 1>&6
+if test $ac_cv_type_u_int32_t = no; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining u_int32_t = uint32_t
+EOF
+cat >> confdefs.h <<\EOF
+#define u_int32_t uint32_t
+EOF
+}
+
+fi
+
+if test $ac_cv_type_u_int32_t = yes; then
+{ test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_U_INT32_T = 1
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_U_INT32_T 1
+EOF
+}
+
+fi
+echo $ac_n "checking for u_int64_t""... $ac_c" 1>&6
+echo "configure:14421: checking for u_int64_t" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 14424 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])u_int64_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_u_int64_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_u_int64_t=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_type_u_int64_t" 1>&6
+if test $ac_cv_type_u_int64_t = no; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining u_int64_t = uint64_t
+EOF
+cat >> confdefs.h <<\EOF
+#define u_int64_t uint64_t
+EOF
+}
+
+fi
+
+if test $ac_cv_type_u_int64_t = yes; then
+{ test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_U_INT64_T = 1
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_U_INT64_T 1
+EOF
+}
+
+fi
+
if test "$with_database_berkdb" != "no"; then
echo $ac_n "checking for Berkeley db.h""... $ac_c" 1>&6
-echo "configure:14290: checking for Berkeley db.h" >&5
+echo "configure:14467: checking for Berkeley db.h" >&5
for header in "db/db.h" "db.h"; do
case "$opsys" in
*freebsd*)
cat > conftest.$ac_ext <<EOF
-#line 14295 "configure"
+#line 14472 "configure"
#include "confdefs.h"
#include <stdlib.h>
＠＠ -14307,7 +14484,7 ＠＠ int main() {
; return 0; }
EOF
-if { (eval echo configure:14311: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:14488: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
db_h_file="$header"; break
else
＠＠ -14318,7 +14495,7 ＠＠ rm -f conftest*
;;
*)
cat > conftest.$ac_ext <<EOF
-#line 14322 "configure"
+#line 14499 "configure"
#include "confdefs.h"
#include <stdlib.h>
＠＠ -14326,21 +14503,29 ＠＠ rm -f conftest*
#ifdef HAVE_INTTYPES_H
#define __BIT_TYPES_DEFINED__
#include <inttypes.h>
+#if !HAVE_U_INT8_T
typedef uint8_t u_int8_t;
+#endif
+#if !HAVE_U_INT16_T
typedef uint16_t u_int16_t;
+#endif
+#if !HAVE_U_INT32_T
typedef uint32_t u_int32_t;
+#endif
#ifdef WE_DONT_NEED_QUADS
+#if !HAVE_U_INT64_T
typedef uint64_t u_int64_t;
#endif
#endif
#endif
+#endif
#include <$header>
int main() {
; return 0; }
EOF
-if { (eval echo configure:14344: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:14529: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
db_h_file="$header"; break
else
＠＠ -14358,9 +14543,9 ＠＠ rm -f conftest*
if test "$with_database_berkdb" != "no"; then
echo $ac_n "checking for Berkeley DB version""... $ac_c" 1>&6
-echo "configure:14362: checking for Berkeley DB version" >&5
+echo "configure:14547: checking for Berkeley DB version" >&5
cat > conftest.$ac_ext <<EOF
-#line 14364 "configure"
+#line 14549 "configure"
#include "confdefs.h"
#include <$db_h_file>
#if DB_VERSION_MAJOR > 1
＠＠ -14372,7 +14557,7 ＠＠ if (eval "$ac_cpp conftest.$ac_ext") 2>&
egrep "yes" >/dev/null 2>&1; then
rm -rf conftest*
cat > conftest.$ac_ext <<EOF
-#line 14376 "configure"
+#line 14561 "configure"
#include "confdefs.h"
#include <$db_h_file>
#if DB_VERSION_MAJOR > 2
＠＠ -14399,10 +14584,10 ＠＠ fi
rm -f conftest*
echo $ac_n "checking for $dbfunc""... $ac_c" 1>&6
-echo "configure:14403: checking for $dbfunc" >&5
+echo "configure:14588: checking for $dbfunc" >&5
cat > conftest.$ac_ext <<EOF
-#line 14406 "configure"
+#line 14591 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $dbfunc(); below. */
＠＠ -14425,7 +14610,7 ＠＠ $dbfunc();
; return 0; }
EOF
-if { (eval echo configure:14429: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:14614: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$dbfunc=yes"
else
＠＠ -14444,12 +14629,12 ＠＠ else
echo $ac_n "checking for $dbfunc in -ldb""... $ac_c" 1>&6
-echo "configure:14448: checking for $dbfunc in -ldb" >&5
+echo "configure:14633: checking for $dbfunc in -ldb" >&5
ac_lib_var=`echo db'_'$dbfunc | sed 'y%./+-%__p_%'`
xe_check_libs=" -ldb "
cat > conftest.$ac_ext <<EOF
-#line 14453 "configure"
+#line 14638 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
＠＠ -14460,7 +14645,7 ＠＠ int main() {
$dbfunc()
; return 0; }
EOF
-if { (eval echo configure:14464: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:14649: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
＠＠ -14524,12 +14709,12 ＠＠ fi
if test "$with_socks" = "yes"; then
echo $ac_n "checking for SOCKSinit in -lsocks""... $ac_c" 1>&6
-echo "configure:14528: checking for SOCKSinit in -lsocks" >&5
+echo "configure:14713: checking for SOCKSinit in -lsocks" >&5
ac_lib_var=`echo socks'_'SOCKSinit | sed 'y%./+-%__p_%'`
xe_check_libs=" -lsocks "
cat > conftest.$ac_ext <<EOF
-#line 14533 "configure"
+#line 14718 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
＠＠ -14540,7 +14725,7 ＠＠ int main() {
SOCKSinit()
; return 0; }
EOF
-if { (eval echo configure:14544: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:14729: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
＠＠ -14595,7 +14780,7 ＠＠ fi
if test "$with_modules" != "no"; then
echo "checking for module support" 1>&6
-echo "configure:14599: checking for module support" >&5
+echo "configure:14784: checking for module support" >&5
if test "$with_msw" = "yes"; then
have_dl=yes;
＠＠ -14611,15 +14796,15 ＠＠ EOF
;;
*) ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for dlfcn.h""... $ac_c" 1>&6
-echo "configure:14615: checking for dlfcn.h" >&5
+echo "configure:14800: checking for dlfcn.h" >&5
cat > conftest.$ac_ext <<EOF
-#line 14618 "configure"
+#line 14803 "configure"
#include "confdefs.h"
#include <dlfcn.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:14623: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:14808: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
＠＠ -14636,16 +14821,16 ＠＠ if eval "test \"`echo '$ac_cv_header_'$a
echo "$ac_t""yes" 1>&6
echo $ac_n "checking for dlopen in -lc""... $ac_c" 1>&6
-echo "configure:14640: checking for dlopen in -lc" >&5
+echo "configure:14825: checking for dlopen in -lc" >&5
cat > conftest.$ac_ext <<EOF
-#line 14642 "configure"
+#line 14827 "configure"
#include "confdefs.h"
#include <dlfcn.h>
int main() {
dlopen ("", 0);
; return 0; }
EOF
-if { (eval echo configure:14649: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:14834: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
have_dl=yes
else
＠＠ -14654,18 +14839,18 ＠＠ else
rm -rf conftest*
echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6
-echo "configure:14658: checking for dlopen in -ldl" >&5
+echo "configure:14843: checking for dlopen in -ldl" >&5
ac_save_LIBS="$LIBS"
LIBS="-ldl $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 14662 "configure"
+#line 14847 "configure"
#include "confdefs.h"
#include <dlfcn.h>
int main() {
dlopen ("", 0);
; return 0; }
EOF
-if { (eval echo configure:14669: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:14854: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
have_dl=yes
else
＠＠ -14694,12 +14879,12 ＠＠ EOF
else
echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6
-echo "configure:14698: checking for shl_load in -ldld" >&5
+echo "configure:14883: checking for shl_load in -ldld" >&5
ac_lib_var=`echo dld'_'shl_load | sed 'y%./+-%__p_%'`
xe_check_libs=" -ldld "
cat > conftest.$ac_ext <<EOF
-#line 14703 "configure"
+#line 14888 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
＠＠ -14710,7 +14895,7 ＠＠ int main() {
shl_load()
; return 0; }
EOF
-if { (eval echo configure:14714: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:14899: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
＠＠ -14737,12 +14922,12 ＠＠ else
echo "$ac_t""no" 1>&6
echo $ac_n "checking for dld_init in -ldld""... $ac_c" 1>&6
-echo "configure:14741: checking for dld_init in -ldld" >&5
+echo "configure:14926: checking for dld_init in -ldld" >&5
ac_lib_var=`echo dld'_'dld_init | sed 'y%./+-%__p_%'`
xe_check_libs=" -ldld "
cat > conftest.$ac_ext <<EOF
-#line 14746 "configure"
+#line 14931 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
＠＠ -14753,7 +14938,7 ＠＠ int main() {
dld_init()
; return 0; }
EOF
-if { (eval echo configure:14757: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:14942: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
＠＠ -14800,7 +14985,7 ＠＠ xehost=$canonical
xealias=$internal_configuration
echo "checking how to build dynamic libraries for ${xehost}" 1>&6
-echo "configure:14804: checking how to build dynamic libraries for ${xehost}" >&5
+echo "configure:14989: checking how to build dynamic libraries for ${xehost}" >&5
# Transform *-*-linux* to *-*-linux-gnu*, to support old configure scripts.
case "$xehost" in
*-*-linux-gnu*) ;;
＠＠ -14828,9 +15013,9 ＠＠ if test "$GCC" = "yes"; then
XEGCC=yes
else
echo $ac_n "checking checking whether we are using GNU C""... $ac_c" 1>&6
-echo "configure:14832: checking checking whether we are using GNU C" >&5
+echo "configure:15017: checking checking whether we are using GNU C" >&5
cat > conftest.$ac_ext <<EOF
-#line 14834 "configure"
+#line 15019 "configure"
#include "confdefs.h"
#ifdef __GNUC__
＠＠ -14852,7 +15037,7 ＠＠ rm -f conftest*
fi
echo $ac_n "checking how to produce PIC code""... $ac_c" 1>&6
-echo "configure:14856: checking how to produce PIC code" >&5
+echo "configure:15041: checking how to produce PIC code" >&5
wl=
can_build_shared=yes
＠＠ -14953,18 +15138,18 ＠＠ if test -n "$dll_cflags"; then
# Check to make sure the dll_cflags actually works.
echo $ac_n "checking if PIC flag ${dll_cflags} really works""... $ac_c" 1>&6
-echo "configure:14957: checking if PIC flag ${dll_cflags} really works" >&5
+echo "configure:15142: checking if PIC flag ${dll_cflags} really works" >&5
save_CFLAGS="$CFLAGS"
CFLAGS="$CFLAGS $dll_cflags -DPIC"
cat > conftest.$ac_ext <<EOF
-#line 14961 "configure"
+#line 15146 "configure"
#include "confdefs.h"
int main() {
int x=0;
; return 0; }
EOF
-if { (eval echo configure:14968: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:15153: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
# On HP-UX, the stripped-down bundled CC doesn't accept +Z, but also
＠＠ -14995,7 +15180,7 ＠＠ cc_produces_so=no
xldf=
xcldf=
echo $ac_n "checking if C compiler can produce shared libraries""... $ac_c" 1>&6
-echo "configure:14999: checking if C compiler can produce shared libraries" >&5
+echo "configure:15184: checking if C compiler can produce shared libraries" >&5
if test "$XEGCC" = yes -o "$__ICC" = yes; then
xcldf="-shared"
xldf="-shared"
＠＠ -15046,14 +15231,14 ＠＠ if test -n "$xcldf"; then
xe_libs=
ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5'
cat > conftest.$ac_ext <<EOF
-#line 15050 "configure"
+#line 15235 "configure"
#include "confdefs.h"
int main() {
int x=0;
; return 0; }
EOF
-if { (eval echo configure:15057: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:15242: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
cc_produces_so=yes
else
＠＠ -15078,7 +15263,7 ＠＠ if test -z "$LTLD"; then
if test "$XEGCC" = yes; then
# Check if gcc -print-prog-name=ld gives a path.
echo $ac_n "checking for ld used by GCC""... $ac_c" 1>&6
-echo "configure:15082: checking for ld used by GCC" >&5
+echo "configure:15267: checking for ld used by GCC" >&5
ac_prog=`($CC -print-prog-name=ld) 2>&5`
case "$ac_prog" in
# Accept absolute paths.
＠＠ -15104,7 +15289,7 ＠＠ echo "configure:15082: checking for ld u
esac
else
echo $ac_n "checking for GNU ld""... $ac_c" 1>&6
-echo "configure:15108: checking for GNU ld" >&5
+echo "configure:15293: checking for GNU ld" >&5
fi
if test -z "$LTLD"; then
＠＠ -15142,7 +15327,7 ＠＠ ld_dynamic_link_flags=
# Check to see if it really is or isn't GNU ld.
echo $ac_n "checking if the linker is GNU ld""... $ac_c" 1>&6
-echo "configure:15146: checking if the linker is GNU ld" >&5
+echo "configure:15331: checking if the linker is GNU ld" >&5
# I'd rather use --version here, but apparently some GNU ld's only accept -v.
if $LTLD -v 2>&1 </dev/null | egrep '(GNU|with BFD)' 1>&5; then
xe_gnu_ld=yes
＠＠ -15170,7 +15355,7 ＠＠ else
# OK - only NOW do we futz about with ld.
# See if the linker supports building shared libraries.
echo $ac_n "checking whether the linker supports shared libraries""... $ac_c" 1>&6
-echo "configure:15174: checking whether the linker supports shared libraries" >&5
+echo "configure:15359: checking whether the linker supports shared libraries" >&5
dll_ld=$CC
dll_ldflags=$LDFLAGS
ld_shlibs=yes
＠＠ -15381,10 +15566,10 ＠＠ EOF
for ac_func in dlerror _dlerror
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:15385: checking for $ac_func" >&5
+echo "configure:15570: checking for $ac_func" >&5
cat > conftest.$ac_ext <<EOF
-#line 15388 "configure"
+#line 15573 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
＠＠ -15407,7 +15592,7 ＠＠ $ac_func();
; return 0; }
EOF
-if { (eval echo configure:15411: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:15596: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
＠＠ -15446,11 +15631,11 ＠＠ done
fi
cat > conftest.$ac_ext <<EOF
-#line 15450 "configure"
+#line 15635 "configure"
#include "confdefs.h"
int main(int c,char *v[]){return 0;}
EOF
-if { (eval echo configure:15454: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5
+if { (eval echo configure:15639: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5
then
:
else
1.151.2.33 +27 -1 XEmacs/xemacs/configure.in
Index: configure.in
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.in,v
retrieving revision 1.151.2.32
retrieving revision 1.151.2.33
diff -u -p -r1.151.2.32 -r1.151.2.33
--- configure.in 2005/03/24 04:56:00 1.151.2.32
+++ configure.in 2005/11/25 02:00:33 1.151.2.33
＠＠ -3592,7 +3592,7 ＠＠ dnl Not all toolkits support all widgets
dnl Avoid using Motif :-(
case "$opsys" in
- *linux* ) lucid_prefers_motif="no" ;;
+ *linux* | cygwin* ) lucid_prefers_motif="no" ;;
* ) lucid_prefers_motif="yes" ;;
esac
＠＠ -4454,6 +4454,24 ＠＠ test "$with_database_gdbm" = "yes" -o \
"$with_database_dbm" = "yes" && \
AC_DEFINE(HAVE_DBM)
+dnl Check for u_int*_t typedefs.
+AC_CHECK_TYPE(u_int8_t, uint8_t)
+if test $ac_cv_type_u_int8_t = yes; then
+AC_DEFINE(HAVE_U_INT8_T,1)
+fi
+AC_CHECK_TYPE(u_int16_t, uint16_t)
+if test $ac_cv_type_u_int16_t = yes; then
+AC_DEFINE(HAVE_U_INT16_T,1)
+fi
+AC_CHECK_TYPE(u_int32_t, uint32_t)
+if test $ac_cv_type_u_int32_t = yes; then
+AC_DEFINE(HAVE_U_INT32_T,1)
+fi
+AC_CHECK_TYPE(u_int64_t, uint64_t)
+if test $ac_cv_type_u_int64_t = yes; then
+AC_DEFINE(HAVE_U_INT64_T,1)
+fi
+
dnl Check for Berkeley DB.
if test "$with_database_berkdb" != "no"; then
AC_MSG_CHECKING(for Berkeley db.h)
＠＠ -4478,11 +4496,19 ＠＠ if test "$with_database_berkdb" != "no";
#ifdef HAVE_INTTYPES_H
#define __BIT_TYPES_DEFINED__
#include <inttypes.h>
+#if !HAVE_U_INT8_T
typedef uint8_t u_int8_t;
+#endif
+#if !HAVE_U_INT16_T
typedef uint16_t u_int16_t;
+#endif
+#if !HAVE_U_INT32_T
typedef uint32_t u_int32_t;
+#endif
#ifdef WE_DONT_NEED_QUADS
+#if !HAVE_U_INT64_T
typedef uint64_t u_int64_t;
+#endif
#endif
#endif
#endif
1.8.4.7 +6 -0 XEmacs/xemacs/etc/Attic/PACKAGES
Index: PACKAGES
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/etc/Attic/PACKAGES,v
retrieving revision 1.8.4.6
retrieving revision 1.8.4.7
diff -u -p -r1.8.4.6 -r1.8.4.7
--- PACKAGES 2005/02/19 22:01:59 1.8.4.6
+++ PACKAGES 2005/11/25 02:01:46 1.8.4.7
＠＠ -234,6 +234,9 ＠＠ Deprecated collection of DTDs for psgml.
*** python-modes
Python support.
+*** re-builder
+Interactive development tool for regular expressions.
+
*** reftex
Emacs support for LaTeX cross-references, citations.
＠＠ -340,6 +343,9 ＠＠ Fundamental XEmacs support, you almost c
XEmacs Lisp developer support. This package contains utilities for
supporting Lisp development. It is a single-file package so it may be
tailored.
+
+*** xetla
+(setq mm-coding-system-priorities '(iso-8859-1 iso-8859-15 utf-8))
*** xlib
Emacs interface to X server.
1.266.2.83 +19 -0 XEmacs/xemacs/lisp/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.266.2.82
retrieving revision 1.266.2.83
diff -u -p -r1.266.2.82 -r1.266.2.83
--- ChangeLog 2005/02/24 03:06:06 1.266.2.82
+++ ChangeLog 2005/11/25 02:01:48 1.266.2.83
＠＠ -1,3 +1,22 ＠＠
+2005-06-06 Adrian Aichner <adrian(a)xemacs.org>
+
+ * package-get.el (package-get-init-package):
+ package-get-init-package buglet (21.4.17) by Jeff Mincy
+ <mincy(a)rcn.com> fixing false temporary load-path shadows reported
+ after package installation and simplifying code.
+
+2005-10-18 Ville Skyttä <scop(a)xemacs.org>
+
+ * package-get.el (package-get-download-sites): Sync mirrors list
+ with the XEmacs website.
+ (package-get-pre-release-download-sites): Ditto.
+
+2005-04-06 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * derived.el (derived-mode-merge-syntax-tables):
+ Revert my 21.5-only patch of 2003-07-18 which slipped in
+ through Jerry James's patch of 2004-06-07.
+
2005-02-23 Adrian Aichner <adrian(a)xemacs.org>
* cmdloop.el (keyboard-quit): Remove workaround for
1.4.2.2 +6 -14 XEmacs/xemacs/lisp/derived.el
Index: derived.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/derived.el,v
retrieving revision 1.4.2.1
retrieving revision 1.4.2.2
diff -u -p -r1.4.2.1 -r1.4.2.2
--- derived.el 2004/06/22 01:49:47 1.4.2.1
+++ derived.el 2005/11/25 02:01:49 1.4.2.2
＠＠ -421,20 +421,12 ＠＠ Where the new table already has an entry
;; check for inheritance.
(map-char-table
#'(lambda (key value)
- (let ((newval (get-range-char-table key new 'multi)))
- (cond ((eq newval 'multi) ; OK, dive into the class hierarchy
- (map-char-table
- #'(lambda (key1 value1)
- (when (eq ?＠ (char-syntax-from-code
- (get-range-char-table key new ?＠)))
- (put-char-table key1 value new))
- nil)
- new
- key))
- ((eq ?＠ (char-syntax-from-code newval)) ;; class at once
- (put-char-table key value new))))
- nil)
- old))
+ (if (eq ?＠ (char-syntax-from-code value))
+ (map-char-table #'(lambda (key1 value1)
+ (put-char-table key1 value1 new))
+ old
+ key)))
+ new))
;; Merge an old abbrev table into a new one.
;; This function requires internal knowledge of how abbrev tables work,
1.39.2.10 +13 -19 XEmacs/xemacs/lisp/package-get.el
Index: package-get.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/package-get.el,v
retrieving revision 1.39.2.9
retrieving revision 1.39.2.10
diff -u -p -r1.39.2.9 -r1.39.2.10
--- package-get.el 2004/06/28 01:19:56 1.39.2.9
+++ package-get.el 2005/11/25 02:01:49 1.39.2.10
＠＠ -204,6 +204,7 ＠＠ directory."
("US (Main XEmacs Site)"
"ftp.xemacs.org" "pub/xemacs/packages")
;; In alphabetical order of Country, our mirrors...
+ ("Argentina (xmundo.net)" "xemacs.xmundo.net" "pub/mirrors/xemacs/packages")
("Australia (aarnet.edu.au)" "mirror.aarnet.edu.au" "pub/xemacs/packages")
("Australia (au.xemacs.org)" "ftp.au.xemacs.org" "pub/xemacs/packages")
("Austria (at.xemacs.org)" "ftp.at.xemacs.org" "editors/xemacs/packages")
＠＠ -211,7 +212,7 ＠＠ directory."
("Brazil (br.xemacs.org)" "ftp.br.xemacs.org" "pub/xemacs/packages")
("Canada (ca.xemacs.org)" "ftp.ca.xemacs.org" "pub/Mirror/xemacs/packages")
("Canada (crc.ca)" "ftp.crc.ca" "pub/packages/editors/xemacs/packages")
- ("Canada (ualberta.ca)" "sunsite.ualberta.ca" "pub/Mirror/xemacs/packages")
+ ("Canada (nrc.ca)" "ftp.nrc.ca" "pub/packages/editors/xemacs/packages")
("Czech Republic (cz.xemacs.org)" "ftp.cz.xemacs.org" "MIRRORS/ftp.xemacs.org/pub/xemacs/packages")
("Denmark (dk.xemacs.org)" "ftp.dk.xemacs.org" "pub/emacs/xemacs/packages")
("Finland (fi.xemacs.org)" "ftp.fi.xemacs.org" "pub/mirrors/ftp.xemacs.org/pub/tux/xemacs/packages")
＠＠ -219,8 +220,9 ＠＠ directory."
("France (mirror.cict.fr)" "mirror.cict.fr" "xemacs/packages")
("France (pasteur.fr)" "ftp.pasteur.fr" "pub/computing/xemacs/packages")
("Germany (de.xemacs.org)" "ftp.de.xemacs.org" "pub/ftp.xemacs.org/tux/xemacs/packages")
- ("Germany (tu-darmstadt.de)" "ftp.tu-darmstadt.de" "pub/editors/xemacs/packages")
+ ("Iceland (is.xemacs.org)" "ftp.is.xemacs.org" "pub/xemacs/packages")
("Ireland (ie.xemacs.org)" "ftp.ie.xemacs.org" "mirrors/ftp.xemacs.org/pub/xemacs/packages")
+ ("Ireland (heanet.ie)" "ftp.heanet.ie" "mirrors/ftp.xemacs.org/packages")
("Italy (it.xemacs.org)" "ftp.it.xemacs.org" "unix/packages/XEMACS/packages")
("Japan (aist.go.jp)" "ring.aist.go.jp" "pub/text/xemacs/packages")
("Japan (asahi-net.or.jp)" "ring.asahi-net.or.jp" "pub/text/xemacs/packages")
＠＠ -234,7 +236,6 ＠＠ directory."
("Norway (no.xemacs.org)" "ftp.no.xemacs.org" "pub/xemacs/packages")
("Poland (pl.xemacs.org)" "ftp.pl.xemacs.org" "pub/unix/editors/xemacs/packages")
("Russia (ru.xemacs.org)" "ftp.ru.xemacs.org" "pub/xemacs/packages")
- ("Slovakia (sk.xemacs.org)" "ftp.sk.xemacs.org" "pub/mirrors/xemacs/packages")
("South Africa (za.xemacs.org)" "ftp.za.xemacs.org" "mirrorsites/ftp.xemacs.org/packages")
("Sweden (se.xemacs.org)" "ftp.se.xemacs.org" "pub/gnu/xemacs/packages")
("Switzerland (ch.xemacs.org)" "ftp.ch.xemacs.org" "mirror/xemacs/packages")
＠＠ -263,6 +264,8 ＠＠ variable actually used to specify packag
("Pre-Releases (Main XEmacs Site)" "ftp.xemacs.org"
"pub/xemacs/beta/experimental/packages")
;; In alphabetical order of Country, our mirrors...
+ ("Argentina Pre-Releases (xmundo.net)" "xemacs.xmundo.net"
+ "pub/mirrors/xemacs/beta/experimental/packages")
("Australia Pre-Releases (aarnet.edu.au)" "mirror.aarnet.edu.au"
"pub/xemacs/beta/experimental/packages")
("Australia Pre-Releases (au.xemacs.org)" "ftp.au.xemacs.org"
＠＠ -275,8 +278,8 ＠＠ variable actually used to specify packag
"pub/Mirror/xemacs/beta/experimental/packages")
("Canada Pre-Releases (crc.ca)" "ftp.crc.ca"
"pub/packages/editors/xemacs/beta/experimental/packages")
- ("Canada Pre-Releases (ualberta.ca)" "sunsite.ualberta.ca"
- "pub/Mirror/xemacs/beta/experimental/packages")
+ ("Canada Pre-Releases (nrc.ca)" "ftp.nrc.ca"
+ "pub/packages/editors/xemacs/beta/experimental/packages")
("Czech Republic Pre-Releases (cz.xemacs.org)" "ftp.cz.xemacs.org"
"MIRRORS/ftp.xemacs.org/pub/xemacs/xemacs-21.5/experimental/packages")
("Denmark Pre-Releases (dk.xemacs.org)" "ftp.dk.xemacs.org"
＠＠ -291,10 +294,12 ＠＠ variable actually used to specify packag
"pub/computing/xemacs/beta/experimental/packages")
("Germany Pre-Releases (de.xemacs.org)" "ftp.de.xemacs.org"
"pub/ftp.xemacs.org/tux/xemacs/beta/experimental/packages")
- ("Germany Pre-Releases (tu-darmstadt.de)" "ftp.tu-darmstadt.de"
- "pub/editors/xemacs/beta/experimental/packages")
+ ("Iceland Pre-Releases (is.xemacs.org)" "ftp.is.xemacs.org"
+ "pub/xemacs/beta/experimental/packages")
("Ireland Pre-Releases (ie.xemacs.org)" "ftp.ie.xemacs.org"
"mirrors/ftp.xemacs.org/pub/xemacs/beta/experimental/packages")
+ ("Ireland Pre-Releases (heanet.ie)" "ftp.heanet.ie"
+ "mirrors/ftp.xemacs.org/beta/experimental/packages")
("Italy Pre-Releases (it.xemacs.org)" "ftp.it.xemacs.org"
"unix/packages/XEMACS/beta/experimental/packages")
("Japan Pre-Releases (aist.go.jp)" "ring.aist.go.jp"
＠＠ -316,10 +321,6 ＠＠ variable actually used to specify packag
"pub/unix/editors/xemacs/beta/experimental/packages")
("Russia Pre-Releases (ru.xemacs.org)" "ftp.ru.xemacs.org"
"pub/xemacs/beta/experimental/packages")
- ("Saudi Arabia Pre-Releases (sa.xemacs.org)" "ftp.sa.xemacs.org"
- "pub/mirrors/ftp.xemacs.org/xemacs/xemacs-21.5/experimental/packages")
- ("Slovakia Pre-Releases (sk.xemacs.org)" "ftp.sk.xemacs.org"
- "pub/mirrors/xemacs/beta/experimental/packages")
("South Africa Pre-Releases (za.xemacs.org)" "ftp.za.xemacs.org"
"mirrorsites/ftp.xemacs.org/beta/experimental/packages")
("Sweden Pre-Releases (se.xemacs.org)" "ftp.se.xemacs.org"
＠＠ -844,14 +845,7 ＠＠ Return `t' upon complete success, `nil'
(progn
;; Add lispdir to load-path if it doesn't already exist.
;; NOTE: this does not take symlinks, etc., into account.
- (if (let ((dirs load-path))
- (catch 'done
- (while dirs
- (if (string-equal (car dirs) lispdir)
- (throw 'done nil))
- (setq dirs (cdr dirs)))
- t))
- (setq load-path (cons lispdir load-path)))
+ (add-to-list 'load-path (file-name-as-directory lispdir))
(if (not (package-get-load-package-file lispdir "auto-autoloads"))
(package-get-load-package-file lispdir "_pkg"))
t)
1.290.2.96 +44 -0 XEmacs/xemacs/src/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.290.2.95
retrieving revision 1.290.2.96
diff -u -p -r1.290.2.95 -r1.290.2.96
--- ChangeLog 2005/02/14 04:15:31 1.290.2.95
+++ ChangeLog 2005/11/25 02:01:53 1.290.2.96
＠＠ -1,3 +1,47 ＠＠
+2005-07-11 Malcolm Purvis <malcolmp(a)xemacs.org>
+
+ * glyphs-gtk.c: Rename a local static variable because gcc 4.0
+ says it clashes with a global with the same name.
+
+2005-07-11 Atanu Ghosh <atanu(a)icsi.berkeley.edu>
+
+ * sysdll.c (dll_open): Under MacOS X return NULL under the
+ filename is NULL. Fixes problems finding local symbols under 10.4
+ (Tiger)
+
+2005-11-15 Dr. Volker Zell <Dr.Volker.Zell(a)oracle.com>
+
+ * config.h.in: New HAVE_U_INT*_T defines.
+
+ * database.c: Only use u_int*_t typedefs if not already
+ defined.
+
+2005-04-07 15:08 Enrico Scholz <enrico.scholz(a)informatik.tu-chemnitz.de>
+
+ * src/process-unix.c (unix_open_network_stream): moved
+ 'portbuf' buffer out of an inner block as it is used in the
+ entire function. With gcc4, the stack may get corrupted
+ after leaving this block. This patches adjusts the size of
+ the used buffer also; static '128' bytes are far too much
+ currently and might not suffice for future architectures
+ (e.g. for 512 bit ones ;)). Instead of, use only the really
+ required space (max octets * ln(256)/ln(10) chars + space
+ for '\0' and the sign)
+
+2005-04-08 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * callproc.c: Include sysdir.h, so any necessary Mule processing
+ is done on the current directory name before starting a new
+ process.
+
+2005-04-06 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * chartab.c (Fchar_table_p):
+ (Fget_range_char_table):
+ (Fput_char_table):
+ (Fmap_char_table):
+ Describe range representation and fix typo.
+
2005-02-12 Vin Shelton <acs(a)xemacs.org>
* emacs.c (shut_down_emacs): Advise users to send email to the
1.37.2.3 +1 -0 XEmacs/xemacs/src/Attic/callproc.c
Index: callproc.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Attic/callproc.c,v
retrieving revision 1.37.2.2
retrieving revision 1.37.2.3
diff -u -p -r1.37.2.2 -r1.37.2.3
--- callproc.c 2002/10/31 15:07:30 1.37.2.2
+++ callproc.c 2005/11/25 02:01:56 1.37.2.3
＠＠ -48,6 +48,7 ＠＠ Boston, MA 02111-1307, USA. */
#include "systime.h"
#include "sysproc.h"
#include "sysfile.h" /* Always include after sysproc.h */
+#include "sysdir.h"
#include "syssignal.h" /* Always include before systty.h */
#include "systty.h"
1.14.2.2 +22 -10 XEmacs/xemacs/src/chartab.c
Index: chartab.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/chartab.c,v
retrieving revision 1.14.2.1
retrieving revision 1.14.2.2
diff -u -p -r1.14.2.1 -r1.14.2.2
--- chartab.c 2005/01/31 02:55:05 1.14.2.1
+++ chartab.c 2005/11/25 02:01:56 1.14.2.2
＠＠ -457,15 +457,17 ＠＠ once per character).
When Mule support exists, the types of ranges that can be assigned
values are
--- all characters
+-- all characters (represented by t)
-- an entire charset
--- a single row in a two-octet charset
+-- a single row in a two-octet charset (represented by a vector of two
+ elements: a two-octet charset and a row number; the row must be an
+ integer, not a character)
-- a single character
When Mule support is not present, the types of ranges that can be
assigned values are
--- all characters
+-- all characters (represented by t)
-- a single character
To create a char table, use `make-char-table'.
＠＠ -853,8 +855,11 ＠＠ Find value for CHARACTER in CHAR-TABLE.
}
DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
-Find value for a range in CHAR-TABLE.
+Find value for RANGE in CHAR-TABLE.
If there is more than one value, return MULTI (defaults to nil).
+
+Valid values for RANGE are single characters, charsets, a row in a
+two-octet charset, and all characters. See `put-char-table'.
*/
(range, char_table, multi))
{
＠＠ -1142,8 +1147,9 ＠＠ one of the following:
-- t (all characters are affected)
-- A charset (only allowed when Mule support is present)
--- A vector of two elements: a two-octet charset and a row number
- (only allowed when Mule support is present)
+-- A vector of two elements: a two-octet charset and a row number; the row
+ must be an integer, not a character (only allowed when Mule support is
+ present)
-- A single character
VALUE must be a value appropriate for the type of CHAR-TABLE.
＠＠ -1437,12 +1443,18 ＠＠ slow_map_char_table_fun (struct chartab_
}
DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
-Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
-each key and value in the table.
+Map FUNCTION over CHAR-TABLE until it returns non-nil; return that value.
+FUNCTION is called with two arguments, each key and entry in the table.
-RANGE specifies a subrange to map over and is in the same format as
-the RANGE argument to `put-range-table'. If omitted or t, it defaults to
+RANGE specifies a subrange to map over. If omitted or t, it defaults to
the entire table.
+
+Both RANGE and the keys passed to FUNCTION are in the same format as the
+RANGE argument to `put-char-table'. N.B. This function does NOT map over
+all characters in RANGE, but over the subranges that have been assigned to.
+Thus this function is most suitable for searching a char-table, or for
+populating one char-table based on the contents of another. The current
+implementation does not coalesce ranges all of whose values are the same.
*/
(function, char_table, range))
{
1.61.2.8 +9 -0 XEmacs/xemacs/src/config.h.in
Index: config.h.in
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/config.h.in,v
retrieving revision 1.61.2.7
retrieving revision 1.61.2.8
diff -u -p -r1.61.2.7 -r1.61.2.8
--- config.h.in 2003/08/18 01:42:10 1.61.2.7
+++ config.h.in 2005/11/25 02:01:56 1.61.2.8
＠＠ -422,6 +422,15 ＠＠ void *alloca ();
/* Compile in support for DBM databases? May require libgdbm or libdbm. */
#undef HAVE_DBM
+/* Define to 1 if the system has the type `u_int8_t'. */
+#undef HAVE_U_INT8_T
+/* Define to 1 if the system has the type `u_int16_t'. */
+#undef HAVE_U_INT16_T
+/* Define to 1 if the system has the type `u_int32_t'. */
+#undef HAVE_U_INT32_T
+/* Define to 1 if the system has the type `u_int64_t'. */
+#undef HAVE_U_INT64_T
+
/* Compile in support for Berkeley DB style databases? May require libdb. */
#undef HAVE_BERKELEY_DB
/* Full #include file path for Berkeley DB's db.h */
1.16.2.5 +8 -0 XEmacs/xemacs/src/database.c
Index: database.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/database.c,v
retrieving revision 1.16.2.4
retrieving revision 1.16.2.5
diff -u -p -r1.16.2.4 -r1.16.2.5
--- database.c 2003/06/19 03:34:42 1.16.2.4
+++ database.c 2005/11/25 02:01:57 1.16.2.5
＠＠ -46,13 +46,21 ＠＠ Boston, MA 02111-1307, USA. */
#define __BIT_TYPES_DEFINED__
#include <inttypes.h>
#ifndef __FreeBSD__
+#if !HAVE_U_INT8_T
typedef uint8_t u_int8_t;
+#endif
+#if !HAVE_U_INT16_T
typedef uint16_t u_int16_t;
+#endif
+#if !HAVE_U_INT32_T
typedef uint32_t u_int32_t;
+#endif
#ifdef WE_DONT_NEED_QUADS
+#if !HAVE_U_INT64_T
typedef uint64_t u_int64_t;
#endif
#endif /* WE_DONT_NEED_QUADS */
+#endif /* !defined(__FreeBSD__) */
#endif /* HAVE_INTTYPES_H */
#endif /* !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) */
/* Berkeley DB wants __STDC__ to be defined; else if does `#define const' */
1.2.2.5 +3 -3 XEmacs/xemacs/src/glyphs-gtk.c
Index: glyphs-gtk.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs-gtk.c,v
retrieving revision 1.2.2.4
retrieving revision 1.2.2.5
diff -u -p -r1.2.2.4 -r1.2.2.5
--- glyphs-gtk.c 2005/01/31 02:55:17 1.2.2.4
+++ glyphs-gtk.c 2005/11/25 02:01:57 1.2.2.5
＠＠ -2999,7 +2999,7 ＠＠ complex_vars_of_glyphs_gtk (void)
/* shared data for the image read/parse logic */
static short hexTable[256]; /* conversion value */
-static int initialized = FALSE; /* easier to fill in at run time */
+static int hexTable_initialized = FALSE; /* easier to fill in at run time */
/*
* Table index for the hex values. Initialized once, first time.
＠＠ -3032,7 +3032,7 ＠＠ static void initHexTable()
hexTable['}'] = -1; hexTable['\n'] = -1;
hexTable['\t'] = -1;
- initialized = TRUE;
+ hexTable_initialized = TRUE;
}
/*
＠＠ -3089,7 +3089,7 ＠＠ int read_bitmap_data (fstream, width, he
#define Xmalloc(size) malloc(size)
/* first time initialization */
- if (initialized == FALSE) initHexTable();
+ if (hexTable_initialized == FALSE) initHexTable();
/* error cleanup and return macro */
#define RETURN(code) { if (data) free (data); return code; }
1.20.2.10 +1 -1 XEmacs/xemacs/src/process-unix.c
Index: process-unix.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/process-unix.c,v
retrieving revision 1.20.2.9
retrieving revision 1.20.2.10
diff -u -p -r1.20.2.9 -r1.20.2.10
--- process-unix.c 2005/02/12 02:56:50 1.20.2.9
+++ process-unix.c 2005/11/25 02:01:57 1.20.2.10
＠＠ -1684,13 +1684,13 ＠＠ unix_open_network_stream (Lisp_Object na
volatile int xerrno = 0;
volatile int failed_connect = 0;
char *ext_host;
+ char portbuf[sizeof(long)*3 + 2];
/*
* Caution: service can either be a string or int.
* Convert to a C string for later use by getaddrinfo.
*/
if (INTP (service))
{
- char portbuf[128];
snprintf (portbuf, sizeof (portbuf), "%ld", (long) XINT (service));
portstring = portbuf;
port = htons ((unsigned short) XINT (service));
1.7.2.7 +14 -2 XEmacs/xemacs/src/sysdll.c
Index: sysdll.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/sysdll.c,v
retrieving revision 1.7.2.6
retrieving revision 1.7.2.7
diff -u -p -r1.7.2.6 -r1.7.2.7
--- sysdll.c 2004/03/25 21:08:19 1.7.2.6
+++ sysdll.c 2005/11/25 02:01:58 1.7.2.7
＠＠ -263,11 +263,23 ＠＠ dll_handle
dll_open (const char *fname)
{
NSObjectFileImage file;
- NSObjectFileImageReturnCode ret =
- NSCreateObjectFileImageFromFile(fname, &file);
+ NSObjectFileImageReturnCode ret;
+
+ /*
+ * MacOS X dll support is for bundles, not the current executable, so return
+ * NULL is this case. However, dll_function() uses a special hack where a
+ * NULL handle can be used to find executable symbols. This satisfies the
+ * needs of ui-gtk.c but is not a general solution.
+ */
+ if (fname == NULL)
+ return NULL;
+
+ ret = NSCreateObjectFileImageFromFile(fname, &file);
+
if (ret != NSObjectFileImageSuccess) {
return NULL;
}
+
return (dll_handle)NSLinkModule(file, fname,
NSLINKMODULE_OPTION_BINDNOW |
NSLINKMODULE_OPTION_PRIVATE |
- 1 participants
- 0 comments
CVS update by crestani xemacs/src, buffer.c, console-gtk-impl.h, console-stream-impl.h, console-stream.h, console-x-impl.h, device-msw.c, dumper.c, event-msw.c, frame-gtk.c, glyphs.h, objects-tty-impl.h, specifier.c ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: crestani
Date: 05/11/25 02:42:26
Modified: xemacs/src .cvsignore ChangeLog Makefile.in.in alloc.c
buffer.c buffer.h bytecode.c bytecode.h config.h.in
console-gtk-impl.h console-msw-impl.h
console-stream-impl.h console-stream.c
console-stream.h console-tty-impl.h console-tty.c
console-x-impl.h console.c depend device-gtk.c
device-msw.c device-tty.c device-x.c device.c
dumper.c dynarr.c elhash.c elhash.h emacs.c eval.c
event-msw.c events.c extents.c extents.h faces.h
frame-gtk.c frame-msw.c frame-x.c frame.c glyphs.c
glyphs.h lisp.h lrecord.h mc-alloc.c mc-alloc.h
objects-tty-impl.h objects-tty.c objects.c print.c
specifier.c specifier.h syntax.c syntax.h window.c
Added: xemacs/src .dbxrc.in .gdbinit.in gc.c gc.h vdb-fake.c
vdb-mach.c vdb-posix.c vdb-win32.c vdb.c vdb.h
Removed: xemacs/src .dbxrc .gdbinit
Log:
Incremental Garbage Collector
Revision Changes Path
1.473 +9 -0 XEmacs/xemacs/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/ChangeLog,v
retrieving revision 1.472
retrieving revision 1.473
diff -u -p -r1.472 -r1.473
--- ChangeLog 2005/11/22 07:14:47 1.472
+++ ChangeLog 2005/11/25 01:41:31 1.473
＠＠ -1,3 +1,12 ＠＠
+2005-11-21 Marcus Crestani <crestani(a)xemacs.org>
+
+ Incremental Garbage Collector
+
+ * configure.ac: Add newgc option; if newgc, turn on kkcc and
+ mc-alloc. Add checks for write barrier, determine which write
+ barrier to use. Add vdb option to override write barrier
+ auto-detection. Generate .gdbinit and .dbxrc.
+
2005-11-22 Ben Wing <ben(a)xemacs.org>
* dynodump/Makefile.in.in (mostlyclean):
1.261 +900 -6 XEmacs/xemacs/configure
Index: configure
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/configure,v
retrieving revision 1.260
retrieving revision 1.261
diff -u -p -r1.260 -r1.261
--- configure 2005/11/16 11:53:47 1.260
+++ configure 2005/11/25 01:41:32 1.261
＠＠ -1154,6 +1154,14 ＠＠ Memory allocation options
with `mc-alloc').
--with-kkcc Enable experimental new GC algorithms.
--with-mc-alloc Enable experimental new allocator.
+ --with-newgc Enable new incremental garbage collector.
+ --with-vdb=TYPE Override auto-detection of virtual-dirty-bit
+ write-barrier implementation for the new garbage
+ collector. TYPE must be one of "auto" (for
+ auto-detection), "posix", "win32", "mach", or "fake"
+ (uses the new garbage collector but disables
+ incremental collections). The default is to use
+ auto-detection.
Emacs Lisp options
------------------
＠＠ -3366,7 +3374,106 ＠＠ if test "${with_mc_alloc+set}" = set; th
else
enable_mc_alloc=yes
fi;
+# If --with-newgc or --without-newgc were given then copy the value to the
+# equivalent enable_newgc variable.
+if test "${with_newgc+set}" = set; then
+ enable_newgc="$with_newgc"
+fi;
+# If -enable-newgc or --disable-newgc were given then copy the value to the
+# equivalent with_newgc variable.
+if test "${enable_newgc+set}" = set; then
+ with_newgc="$enable_newgc"
+fi;
+# Check whether --with-newgc or --without-newgc was given.
+if test "${with_newgc+set}" = set; then
+ enableval="$with_newgc"
+ withval="$with_newgc"
+
+fi;
+_vdb_notfirst=""
+with_vdb_auto=
+enable_vdb_auto=
+with_vdb_posix=
+enable_vdb_posix=
+with_vdb_win32=
+enable_vdb_win32=
+with_vdb_mach=
+enable_vdb_mach=
+with_vdb_fake=
+enable_vdb_fake=
+with_vdb_no=
+enable_vdb_no=
+
+_vdb_types="auto posix win32 mach fake no"
+_vdb_default="auto,posix,win32,mach,fake,no"
+
+
+# If --with-vdb or --without-vdb were given then copy the value to the
+# equivalent enable_vdb variable.
+if test "${with_vdb+set}" = set; then
+ enable_vdb="$with_vdb"
+fi;
+# If -enable-vdb or --disable-vdb were given then copy the value to the
+# equivalent with_vdb variable.
+if test "${enable_vdb+set}" = set; then
+ with_vdb="$enable_vdb"
+fi;
+# Check whether --with-vdb or --without-vdb was given.
+if test "${with_vdb+set}" = set; then
+ enableval="$with_vdb"
+ withval="$with_vdb"
+ for y in $_vdb_types; do
+ eval "with_vdb_$y=no"
+ eval "enable_vdb_$y=no"
+done
+for x in `echo "$with_vdb" | sed -e 's/,/ /g'` ; do
+ _vdb_all_default=""
+ _vdb_found=""
+ case "$x" in
+ n | no | non | none ) _vdb_all_default=no ;;
+ a | al | all | both ) _vdb_all_default=yes ;;
+ esac
+
+ if test -z "$_vdb_all_default"; then
+ for y in $_vdb_types; do
+ if test "$x" = "$y"; then
+ _vdb_found=yes
+ eval "with_vdb_$y=yes"
+ eval "enable_vdb_$y=yes"
+ elif test "$x" = "no$y"; then
+ _vdb_found=yes
+ eval "with_vdb_$y=no"
+ eval "enable_vdb_$y=no"
+ fi
+ done
+ test -z "$_vdb_found" && _vdb_bogus=yes
+ fi
+ if test "$_vdb_bogus" = "yes" -o \
+ \( -n "$_vdb_all_default" -a -n "$_vdb_notfirst" \) ; then
+ (echo "$progname: Usage error:"
+echo " " "Valid values for the --with-vdb option are:
+$_vdb_types. With prefix \"no\", switch it off.
+Defaults may be overridden with \`all' or \`none' first in the list.
+Hardcoded default is: $_vdb_default."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1
+ elif test -n "$_vdb_all_default" ; then
+ for y in $_vdb_types; do
+ eval "with_vdb_$y=$_vdb_all_default"
+ eval "enable_vdb_$y=$_vdb_all_default"
+ done
+ fi
+ _vdb_notfirst=yes
+done
+unset _vdb_bogus _vdb_found _vdb_notfirst _vdb_types
+unset _vdb_default _vdb_all_default x y
+
+
+
+else
+ enable_vdb="auto"
+fi;
+
# If --with-modules or --without-modules were given then copy the value to the
# equivalent enable_modules variable.
if test "${with_modules+set}" = set; then
＠＠ -4431,6 +4538,38 ＠＠ if test -z "$enable_pdump"; then
esac
fi
+if test "$enable_newgc" = "yes"; then
+ if test "$enable_vdb" = "auto"; then
+ case "$opsys" in
+ darwin ) cat >>confdefs.h <<\_ACEOF
+#define VDB_MACH 1
+_ACEOF
+ have_vdb_mach=yes ;;
+ cygwin* ) cat >>confdefs.h <<\_ACEOF
+#define VDB_WIN32 1
+_ACEOF
+ have_vdb_win32=yes ;;
+ linux* ) check_vdb_posix=yes ;;
+ freebsd ) check_vdb_posix=yes ;;
+ * ) check_vdb_posix=yes ;;
+ esac
+ else
+ case "$enable_vdb" in
+ mach ) cat >>confdefs.h <<\_ACEOF
+#define VDB_MACH 1
+_ACEOF
+ have_vdb_mach=yes ;;
+ win32 ) cat >>confdefs.h <<\_ACEOF
+#define VDB_WIN32 1
+_ACEOF
+ have_vdb_win32=yes ;;
+ posix ) check_vdb_posix=yes ;;
+ fake ) have_vdb_fake=yes ;;
+ no ) have_vdb_fake=yes ;;
+ esac
+ fi
+fi
+
if test -z "$with_dynamic"; then
case "$opsys" in
hpux* | sunos4* ) with_dynamic=no ;;
＠＠ -8630,6 +8769,11 ＠＠ if test -z "$enable_dump_in_exec"; then
fi
fi
+if test "$enable_newgc" = "yes"; then
+ enable_mc_alloc=yes
+ enable_kkcc=yes
+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 ""
＠＠ -28581,14 +28725,662 ＠＠ echo "$as_me: WARNING: Use of getaddrinf
esac
fi
+if test "$check_vdb_posix" = "yes" ; then
+ echo "$as_me:$LINENO: checking for mprotect" >&5
+echo $ECHO_N "checking for mprotect... $ECHO_C" >&6
+if test "${ac_cv_func_mprotect+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+/* Define mprotect to an innocuous variant, in case <limits.h> declares mprotect.
+ For example, HP-UX 11i <limits.h> declares gettimeofday. */
+#define mprotect innocuous_mprotect
+
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char mprotect (); below.
+ Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ <limits.h> exists even on freestanding compilers. */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef mprotect
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char mprotect ();
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_mprotect) || defined (__stub___mprotect)
+choke me
+#else
+char (*f) () = mprotect;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != mprotect;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_func_mprotect=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_func_mprotect=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_func_mprotect" >&5
+echo "${ECHO_T}$ac_cv_func_mprotect" >&6
+if test $ac_cv_func_mprotect = yes; then
+ cat >>confdefs.h <<\_ACEOF
+#define HAVE_MPROTECT 1
+_ACEOF
+ have_vdb_mprotect=yes
+fi
+
+
+ echo "$as_me:$LINENO: checking for sigaction" >&5
+echo $ECHO_N "checking for sigaction... $ECHO_C" >&6
+if test "${ac_cv_func_sigaction+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+/* Define sigaction to an innocuous variant, in case <limits.h> declares sigaction.
+ For example, HP-UX 11i <limits.h> declares gettimeofday. */
+#define sigaction innocuous_sigaction
+
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char sigaction (); below.
+ Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ <limits.h> exists even on freestanding compilers. */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef sigaction
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char sigaction ();
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_sigaction) || defined (__stub___sigaction)
+choke me
+#else
+char (*f) () = sigaction;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != sigaction;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_func_sigaction=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_func_sigaction=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_func_sigaction" >&5
+echo "${ECHO_T}$ac_cv_func_sigaction" >&6
+if test $ac_cv_func_sigaction = yes; then
+ cat >>confdefs.h <<\_ACEOF
+#define HAVE_SIGACTION 1
+_ACEOF
+ have_vdb_sigaction=yes
+else
+ have_vdb_sigaction=no
+fi
+
+ echo "$as_me:$LINENO: checking for struct siginfo.si_addr" >&5
+echo $ECHO_N "checking for struct siginfo.si_addr... $ECHO_C" >&6
+if test "${ac_cv_member_struct_siginfo_si_addr+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <signal.h>
+
+int
+main ()
+{
+static struct siginfo ac_aggr;
+if (ac_aggr.si_addr)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_member_struct_siginfo_si_addr=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <signal.h>
+
+int
+main ()
+{
+static struct siginfo ac_aggr;
+if (sizeof ac_aggr.si_addr)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_member_struct_siginfo_si_addr=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_member_struct_siginfo_si_addr=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_member_struct_siginfo_si_addr" >&5
+echo "${ECHO_T}$ac_cv_member_struct_siginfo_si_addr" >&6
+if test $ac_cv_member_struct_siginfo_si_addr = yes; then
+ cat >>confdefs.h <<\_ACEOF
+#define HAVE_STRUCT_SIGINFO_SI_ADDR 1
+_ACEOF
+ have_si_addr=yes
+fi
+
+ echo "$as_me:$LINENO: checking for siginfo_t.si_addr" >&5
+echo $ECHO_N "checking for siginfo_t.si_addr... $ECHO_C" >&6
+if test "${ac_cv_member_siginfo_t_si_addr+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <signal.h>
+
+int
+main ()
+{
+static siginfo_t ac_aggr;
+if (ac_aggr.si_addr)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_member_siginfo_t_si_addr=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <signal.h>
+
+int
+main ()
+{
+static siginfo_t ac_aggr;
+if (sizeof ac_aggr.si_addr)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_member_siginfo_t_si_addr=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_member_siginfo_t_si_addr=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_member_siginfo_t_si_addr" >&5
+echo "${ECHO_T}$ac_cv_member_siginfo_t_si_addr" >&6
+if test $ac_cv_member_siginfo_t_si_addr = yes; then
+ cat >>confdefs.h <<\_ACEOF
+#define HAVE_SIGINFO_T_SI_ADDR 1
+_ACEOF
+ have_si_addr=yes
+fi
+
+ if test "$have_si_addr" != "yes" ; then
+ have_vdb_sigaction=no
+ fi
+
+ echo "$as_me:$LINENO: checking for signal" >&5
+echo $ECHO_N "checking for signal... $ECHO_C" >&6
+if test "${ac_cv_func_signal+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+/* Define signal to an innocuous variant, in case <limits.h> declares signal.
+ For example, HP-UX 11i <limits.h> declares gettimeofday. */
+#define signal innocuous_signal
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char signal (); below.
+ Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ <limits.h> exists even on freestanding compilers. */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+#undef signal
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char signal ();
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_signal) || defined (__stub___signal)
+choke me
+#else
+char (*f) () = signal;
+#endif
+#ifdef __cplusplus
+}
+#endif
+int
+main ()
+{
+return f != signal;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_func_signal=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+ac_cv_func_signal=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_func_signal" >&5
+echo "${ECHO_T}$ac_cv_func_signal" >&6
+if test $ac_cv_func_signal = yes; then
+ cat >>confdefs.h <<\_ACEOF
+#define HAVE_SIGNAL 1
+_ACEOF
+ have_vdb_signal=yes
+fi
+ echo "$as_me:$LINENO: checking for struct sigcontext.cr2" >&5
+echo $ECHO_N "checking for struct sigcontext.cr2... $ECHO_C" >&6
+if test "${ac_cv_member_struct_sigcontext_cr2+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <signal.h>
+int
+main ()
+{
+static struct sigcontext ac_aggr;
+if (ac_aggr.cr2)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_member_struct_sigcontext_cr2=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <signal.h>
+
+int
+main ()
+{
+static struct sigcontext ac_aggr;
+if (sizeof ac_aggr.cr2)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_member_struct_sigcontext_cr2=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_member_struct_sigcontext_cr2=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_member_struct_sigcontext_cr2" >&5
+echo "${ECHO_T}$ac_cv_member_struct_sigcontext_cr2" >&6
+if test $ac_cv_member_struct_sigcontext_cr2 = yes; then
+ cat >>confdefs.h <<\_ACEOF
+#define HAVE_STRUCT_SIGCONTEXT_CR2 1
+_ACEOF
+ have_cr2=yes
+fi
+
+
+ if test "$have_cr2" != "yes" ; then
+ have_vdb_signal=no
+ fi
+
+ if test "$have_vdb_mprotect" != "yes" ; then
+ have_vdb_sigaction=no
+ have_vdb_signal=no
+ fi
+
+ if test "$have_vdb_sigaction" != "yes" -a "$have_vdb_signal" != "yes" ; then
+ have_vdb_posix=no
+ have_vdb_fake=yes
+ else
+ have_vdb_posix=yes
+ have_vdb_fake=no
+ fi
+fi
+
+
+
+
+
+
+
+
+
for ac_func in getpt _getpty grantpt unlockpt ptsname killpg tcgetpgrp
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
＠＠ -37220,14 +38012,14 ＠＠ if test "$verbose" = "yes"; then
fi
-if test -f "$srcdir/src/.gdbinit" -a ! -f "src/.gdbinit"; then
- test "$verbose" = "yes" && echo "creating src/.gdbinit"
- echo "source $srcdir/src/.gdbinit" > "src/.gdbinit"
+if test -f "$srcdir/src/.gdbinit.in" -a ! -f "src/.gdbinit.in"; then
+ test "$verbose" = "yes" && echo "creating src/.gdbinit.in"
+ echo "source $srcdir/src/.gdbinit.in" > "src/.gdbinit.in"
fi
-if test -f "$srcdir/src/.dbxrc" -a ! -f "src/.dbxrc"; then
- test "$verbose" = "yes" && echo "creating src/.dbxrc"
- echo ". $srcdir/src/.dbxrc" > "src/.dbxrc"
+if test -f "$srcdir/src/.dbxrc.in" -a ! -f "src/.dbxrc.in"; then
+ test "$verbose" = "yes" && echo "creating src/.dbxrc.in"
+ echo ". $srcdir/src/.dbxrc.in" > "src/.dbxrc.in"
fi
if test -f "$srcdir/TAGS" -a ! -f "TAGS"; then
＠＠ -37529,6 +38321,18 ＠＠ test "$enable_mc_alloc" = "yes" && ca
#define MC_ALLOC 1
_ACEOF
+test "$enable_newgc" = "yes" && cat >>confdefs.h <<\_ACEOF
+#define NEW_GC 1
+_ACEOF
+
+test "$have_vdb_posix" = "yes" && cat >>confdefs.h <<\_ACEOF
+#define VDB_POSIX 1
+_ACEOF
+
+test "$have_vdb_fake" = "yes" && cat >>confdefs.h <<\_ACEOF
+#define VDB_FAKE 1
+_ACEOF
+
test "$enable_quick_build" = "yes" && cat >>confdefs.h <<\_ACEOF
#define QUICK_BUILD 1
_ACEOF
＠＠ -37830,6 +38634,32 ＠＠ if test "$enable_mc_alloc" = yes ; then
echo " WARNING: turn it off."
echo " WARNING: ---------------------------------------------------------"
fi
+test "$enable_newgc" = yes && echo " Using the new incremental garbage collector."
+if test "$have_vdb_posix" = yes ; then
+ if test "$have_vdb_sigaction" = yes ; then
+ echo " Using POSIX sigaction() to install fault handler."
+ else
+ echo " Using POSIX signal() to install vdb fault handler."
+ fi
+fi
+if test "$have_vdb_win32" = yes ; then
+ echo " Using special WIN32 vdb fault handler."
+fi
+if test "$have_vdb_mach" = yes ; then
+ echo " Using mach exception mechanism as vdb fault handler."
+fi
+if test "$have_vdb_fake" = yes && test "$enable_vdb" != fake; then
+ echo " WARNING: ---------------------------------------------------------"
+ echo " WARNING: The new incremental garbage collector is enabled, but"
+ echo " WARNING: a virtual dirty bit implementation is not yet available"
+ echo " WARNING: on this system. XEmacs will crash if you try to switch on"
+ echo " WARNUNG: incremental garbage collection!"
+ echo " WARNING: Use \`--disable-newgc' to turn incremental gc off."
+ echo " WARNING: ---------------------------------------------------------"
+fi
+if test "$have_vdb_fake" = yes && test "$enable_vdb" == fake; then
+ echo " Virtual dirty bit write barrier manually disabled."
+fi
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."
＠＠ -39254,6 +40084,70 ＠＠ $CPP -I. -I${srcdir}/src -DUSE_GNU_MAKE
chmod 444 Makefile.new
mv -f Makefile.new GNUmakefile
+ if test -r ".gdbinit.in"; then
+ rm -f junk.c
+ < .gdbinit.in \
+ sed -e '/^# Generated/d' \
+ -e 's%/\*\*/#.*%%' \
+ -e 's/^ *# */#/' \
+ -e '/^##/d' \
+ -e '/^#/ {
+p
+d
+}' \
+ -e '/./ {
+s/\([\"]\)/\\\1/g
+s/^/"/
+s/$/"/
+}' > junk.c;
+
+ echo creating $dir/.gdbinit
+$CPP -I. -I${srcdir}/src junk.c \
+ | sed -e 's/^\#.*//' \
+ -e 's/^[ TAB][ TAB]*$//'\
+ -e 's/^ / /' \
+ -e '/^[ ]*$/d' \
+ -e '/^\"/ {
+ s/\\\([\"]\)/\1/g
+ s/^[ TAB]*\"//
+ s/\"[ TAB]*$//
+}' > Makefile.new
+ chmod 444 Makefile.new
+ mv -f Makefile.new .gdbinit
+
+ fi
+ if test -r ".dbxrc.in"; then
+ rm -f junk.c
+ < .dbxrc.in \
+ sed -e '/^# Generated/d' \
+ -e 's%/\*\*/#.*%%' \
+ -e 's/^ *# */#/' \
+ -e '/^##/d' \
+ -e '/^#/ {
+p
+d
+}' \
+ -e '/./ {
+s/\([\"]\)/\\\1/g
+s/^/"/
+s/$/"/
+}' > junk.c;
+
+ echo creating $dir/.dbxrc
+$CPP -I. -I${srcdir}/src junk.c \
+ | sed -e 's/^\#.*//' \
+ -e 's/^[ TAB][ TAB]*$//'\
+ -e 's/^ / /' \
+ -e '/^[ ]*$/d' \
+ -e '/^\"/ {
+ s/\\\([\"]\)/\1/g
+ s/^[ TAB]*\"//
+ s/\"[ TAB]*$//
+}' > Makefile.new
+ chmod 444 Makefile.new
+ mv -f Makefile.new .dbxrc
+
+ fi
if test -r "xemacs.def.in"; then
rm -f junk.c
cp xemacs.def.in junk.c
1.22 +126 -6 XEmacs/xemacs/configure.ac
Index: configure.ac
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.ac,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -p -r1.21 -r1.22
--- configure.ac 2005/11/16 11:53:53 1.21
+++ configure.ac 2005/11/25 01:41:36 1.22
＠＠ -875,6 +875,18 ＠＠ XE_MERGED_ARG([kkcc],
XE_MERGED_ARG([mc-alloc],
AC_HELP_STRING([--enable-mc-alloc],[Enable experimental new allocator.]),
[], [enable_mc_alloc=yes])
+XE_MERGED_ARG([newgc],
+ AC_HELP_STRING([--enable-newgc],[Enable new incremental garbage collector.]),
+ [], [])
+XE_COMPLEX_ARG([vdb],
+ AC_HELP_STRING([--enable-vdb=TYPE],[Override auto-detection of
+ virtual-dirty-bit write-barrier implementation for the
+ new garbage collector. TYPE must be one of "auto" (for
+ auto-detection), "posix", "win32", "mach", or "fake"
+ (uses the new garbage collector but disables
+ incremental collections). The default is to
+ use auto-detection.]),
+ [], [enable_vdb="auto"],[auto,posix,win32,mach,fake,no])
dnl
XE_HELP_SUBSECTION([Emacs Lisp options])
XE_MERGED_ARG([modules],
＠＠ -1683,6 +1695,29 ＠＠ if test -z "$enable_pdump"; then
esac
fi
+if test "$enable_newgc" = "yes"; then
+ if test "$enable_vdb" = "auto"; then
+ case "$opsys" in
+ darwin ) AC_DEFINE(VDB_MACH) have_vdb_mach=yes ;;
+ cygwin* ) AC_DEFINE(VDB_WIN32) have_vdb_win32=yes ;;
+ linux* ) check_vdb_posix=yes ;;
+ freebsd ) check_vdb_posix=yes ;;
+dnl bail out immediately
+dnl * ) have_vdb_fake=yes ;;
+dnl if not sure, try posix first, maybe we are lucky
+ * ) check_vdb_posix=yes ;;
+ esac
+ else
+ case "$enable_vdb" in
+ mach ) AC_DEFINE(VDB_MACH) have_vdb_mach=yes ;;
+ win32 ) AC_DEFINE(VDB_WIN32) have_vdb_win32=yes ;;
+ posix ) check_vdb_posix=yes ;;
+ fake ) have_vdb_fake=yes ;;
+ no ) have_vdb_fake=yes ;;
+ esac
+ fi
+fi
+
if test -z "$with_dynamic"; then
case "$opsys" in
hpux* | sunos4* ) with_dynamic=no ;;
＠＠ -2044,6 +2079,12 ＠＠ if test -z "$enable_dump_in_exec"; then
fi
fi
+dnl New incremental garbage collector
+if test "$enable_newgc" = "yes"; then
+ enable_mc_alloc=yes
+ enable_kkcc=yes
+fi
+
dnl For debugging...
test "$verbose" = "yes" && \
PRINT_VAR(libs_machine libs_system libs_termcap libs_standard
＠＠ -4431,6 +4472,48 ＠＠ if test "$ac_cv_func_getaddrinfo" != "no
esac
fi
+dnl check for vdb-related stuff
+if test "$check_vdb_posix" = "yes" ; then
+ dnl no mprotect, no vdb
+ AC_CHECK_FUNC(mprotect,AC_DEFINE(HAVE_MPROTECT) have_vdb_mprotect=yes,)
+
+ dnl sigaction needs either struct siginfo or siginfo_t
+ AC_CHECK_FUNC(sigaction, AC_DEFINE(HAVE_SIGACTION) have_vdb_sigaction=yes,
+ have_vdb_sigaction=no)
+ AC_CHECK_MEMBER(struct siginfo.si_addr,
+ AC_DEFINE(HAVE_STRUCT_SIGINFO_SI_ADDR) have_si_addr=yes,,
+ [#include <signal.h>])
+ AC_CHECK_MEMBER(siginfo_t.si_addr,
+ AC_DEFINE(HAVE_SIGINFO_T_SI_ADDR) have_si_addr=yes,,
+ [#include <signal.h>])
+ if test "$have_si_addr" != "yes" ; then
+ have_vdb_sigaction=no
+ fi
+
+ dnl signal needs struct sigcontext
+ AC_CHECK_FUNC(signal, AC_DEFINE(HAVE_SIGNAL) have_vdb_signal=yes,)
+ AC_CHECK_MEMBER(struct sigcontext.cr2,
+ AC_DEFINE(HAVE_STRUCT_SIGCONTEXT_CR2) have_cr2=yes,,
+ [#include <signal.h>])
+
+ if test "$have_cr2" != "yes" ; then
+ have_vdb_signal=no
+ fi
+
+ if test "$have_vdb_mprotect" != "yes" ; then
+ have_vdb_sigaction=no
+ have_vdb_signal=no
+ fi
+
+ if test "$have_vdb_sigaction" != "yes" -a "$have_vdb_signal" != "yes" ; then
+ have_vdb_posix=no
+ have_vdb_fake=yes
+ else
+ have_vdb_posix=yes
+ have_vdb_fake=no
+ fi
+fi
+
dnl ----------------------------------------------------------------
dnl Check for Unixoid pty/process support.
dnl ----------------------------------------------------------------
＠＠ -5318,15 +5401,15 ＠＠ dnl Create some auxiliary files for deve
dnl ----------------------------------------------
dnl Create a .gdbinit useful for debugging XEmacs
-if test -f "$srcdir/src/.gdbinit" -a ! -f "src/.gdbinit"; then
- test "$verbose" = "yes" && echo "creating src/.gdbinit"
- echo "source $srcdir/src/.gdbinit" > "src/.gdbinit"
+if test -f "$srcdir/src/.gdbinit.in" -a ! -f "src/.gdbinit.in"; then
+ test "$verbose" = "yes" && echo "creating src/.gdbinit.in"
+ echo "source $srcdir/src/.gdbinit.in" > "src/.gdbinit.in"
fi
dnl Create a .dbxrc useful for debugging XEmacs
-if test -f "$srcdir/src/.dbxrc" -a ! -f "src/.dbxrc"; then
- test "$verbose" = "yes" && echo "creating src/.dbxrc"
- echo ". $srcdir/src/.dbxrc" > "src/.dbxrc"
+if test -f "$srcdir/src/.dbxrc.in" -a ! -f "src/.dbxrc.in"; then
+ test "$verbose" = "yes" && echo "creating src/.dbxrc.in"
+ echo ". $srcdir/src/.dbxrc.in" > "src/.dbxrc.in"
fi
dnl Create a useful TAGS file
＠＠ -5584,6 +5667,9 ＠＠ test "$GCC" = "yes" && AC
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_newgc" = "yes" && AC_DEFINE(NEW_GC)
+test "$have_vdb_posix" = "yes" && AC_DEFINE(VDB_POSIX)
+test "$have_vdb_fake" = "yes" && AC_DEFINE(VDB_FAKE)
test "$enable_quick_build" = "yes" && AC_DEFINE(QUICK_BUILD)
test "$with_purify" = "yes" && AC_DEFINE(PURIFY)
test "$with_quantify" = "yes" && AC_DEFINE(QUANTIFY)
＠＠ -5864,6 +5950,32 ＠＠ if test "$enable_mc_alloc" = yes ; then
echo " WARNING: turn it off."
echo " WARNING: ---------------------------------------------------------"
fi
+test "$enable_newgc" = yes && echo " Using the new incremental garbage collector."
+if test "$have_vdb_posix" = yes ; then
+ if test "$have_vdb_sigaction" = yes ; then
+ echo " Using POSIX sigaction() to install fault handler."
+ else
+ echo " Using POSIX signal() to install vdb fault handler."
+ fi
+fi
+if test "$have_vdb_win32" = yes ; then
+ echo " Using special WIN32 vdb fault handler."
+fi
+if test "$have_vdb_mach" = yes ; then
+ echo " Using mach exception mechanism as vdb fault handler."
+fi
+if test "$have_vdb_fake" = yes && test "$enable_vdb" != fake; then
+ echo " WARNING: ---------------------------------------------------------"
+ echo " WARNING: The new incremental garbage collector is enabled, but"
+ echo " WARNING: a virtual dirty bit implementation is not yet available"
+ echo " WARNING: on this system. XEmacs will crash if you try to switch on"
+ echo " WARNUNG: incremental garbage collection!"
+ echo " WARNING: Use \`--disable-newgc' to turn incremental gc off."
+ echo " WARNING: ---------------------------------------------------------"
+fi
+if test "$have_vdb_fake" = yes && test "$enable_vdb" == fake; then
+ echo " Virtual dirty bit write barrier manually disabled."
+fi
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."
＠＠ -5981,6 +6093,14 ＠＠ dnl if it exists (i.e. in the src/ direc
MAKE_JUNK_C(Makefile.in)
CPP_MAKEFILE(,Makefile)
CPP_MAKEFILE(-DUSE_GNU_MAKE,GNUmakefile)
+ if test -r ".gdbinit.in"; then
+ MAKE_JUNK_C(.gdbinit.in)
+ CPP_MAKEFILE(,.gdbinit)
+ fi
+ if test -r ".dbxrc.in"; then
+ MAKE_JUNK_C(.dbxrc.in)
+ CPP_MAKEFILE(,.dbxrc)
+ fi
if test -r "xemacs.def.in"; then
dnl #### We should be using MAKE_JUNK_C instead of the next two lines.
dnl #### But the comments in xemacs.def.in need to be converted from C-style
1.699 +13 -0 XEmacs/xemacs/lisp/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.698
retrieving revision 1.699
diff -u -p -r1.698 -r1.699
--- ChangeLog 2005/11/16 12:13:02 1.698
+++ ChangeLog 2005/11/25 01:41:45 1.699
＠＠ -1,3 +1,16 ＠＠
+2005-11-21 Marcus Crestani <crestani(a)xemacs.org>
+
+ Incremental Garbage Collector
+
+ * cus-start.el (all): Add allow-incremental-gc,
+ gc-cons-incremental-threshold, and
+ gc-incremental-traversal-threshold to alloc customization group.
+ * diagnose.el (show-memory-usage): Additionally allocated memory
+ no longer in use, remove.
+ * diagnose.el (show-lrecord-stats): Additionally allocated memory
+ no longer in use, remove.
+ * diagnose.el (show-gc-stats): New.
+
2005-11-08 Malcolm Purvis <malcolmp(a)xemacs.org>
* help.el:
1.10 +3 -0 XEmacs/xemacs/lisp/cus-start.el
Index: cus-start.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/cus-start.el,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -p -r1.9 -r1.10
--- cus-start.el 2002/12/12 03:20:36 1.9
+++ cus-start.el 2005/11/25 01:41:46 1.10
＠＠ -46,6 +46,7 ＠＠
(let ((all '(;; boolean
(abbrev-all-caps abbrev boolean)
(allow-deletion-of-last-visible-frame frames boolean)
+ (allow-incremental-gc alloc boolean)
(debug-on-quit debug boolean)
(delete-auto-save-files auto-save boolean)
(delete-exited-processes processes-basics boolean)
＠＠ -71,6 +72,8 ＠＠
(bell-inhibit-time sound integer)
(echo-keystrokes keyboard integer)
(gc-cons-threshold alloc integer)
+ (gc-cons-incremental-threshold alloc integer)
+ (gc-incremental-traversal-threshold alloc integer)
(next-screen-context-lines display integer)
(scroll-conservatively display integer)
(scroll-step windows integer)
1.7 +51 -12 XEmacs/xemacs/lisp/diagnose.el
Index: diagnose.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/diagnose.el,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -p -r1.6 -r1.7
--- diagnose.el 2005/11/13 10:56:09 1.6
+++ diagnose.el 2005/11/25 01:41:46 1.7
＠＠ -142,7 +142,7 ＠＠
(princ "\n")
(map-plist #'(lambda (stat num)
(when (string-match
- "\\(.*\\)-storage\\(-additional\\)?$"
+ "\\(.*\\)-storage\\$"
(symbol-name stat))
(incf total num)
(princ (format fmt
＠＠ -237,10 +237,6 ＠＠
(setq begin (point))
(princ "Allocated with lisp allocator:\n")
(show-stats "\\(.*\\)-storage$")
- (princ "\n\n")
- (setq begin (point))
- (princ "Allocated additionally:\n")
- (show-stats "\\(.*\\)-storage-additional$")
(princ (format "\n\ngrand total: %s\n" grandtotal)))
grandtotal))))
＠＠ -253,10 +249,9 ＠＠
(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)))
+ (free-plhs (fourth stats))
+ (globals (fifth stats))
+ (mc-malloced-bytes (sixth stats)))
(with-output-to-temp-buffer "*memory usage*"
(flet ((print-used-plhs (text plhs)
(let ((sum-n-pages 0)
＠＠ -372,9 +367,6 ＠＠
(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")
＠＠ -399,3 +391,50 ＠＠
(princ (format fmt "grand total" mc-malloced-bytes)))
(+ mc-malloced-bytes)))))
+
+
+(defun show-gc-stats ()
+ "Show statistics about garbage collection cycles."
+ (interactive)
+ (let ((buffer "*garbage collection statistics*")
+ (plist (gc-stats))
+ (fmt "%-9s %10s %10s %10s %10s %10s\n"))
+ (flet ((plist-get-stat (category field)
+ (or (plist-get plist (intern (concat category field)))
+ "-"))
+ (show-stats (category)
+ (princ (format fmt category
+ (plist-get-stat category "-total")
+ (plist-get-stat category "-in-last-gc")
+ (plist-get-stat category "-in-this-gc")
+ (plist-get-stat category "-in-last-cycle")
+ (plist-get-stat category "-in-this-cycle")))))
+ (with-output-to-temp-buffer buffer
+ (save-excursion
+ (set-buffer buffer)
+ (princ (format "%s %s\n" "Current phase" (plist-get plist 'phase)))
+ (princ (make-string 64 ?-))
+ (princ "\n")
+ (princ (format fmt "stat" "total" "last-gc" "this-gc"
+ "last-cycle" "this-cylce"))
+ (princ (make-string 64 ?-))
+ (princ "\n")
+ (show-stats "n-gc")
+ (show-stats "n-cycles")
+ (show-stats "enqueued")
+ (show-stats "dequeued")
+ (show-stats "repushed")
+ (show-stats "enqueued2")
+ (show-stats "dequeued2")
+ (show-stats "finalized")
+ (show-stats "freed")
+ (princ (make-string 64 ?-))
+ (princ "\n")
+ (princ (format fmt "explicitly"
+ "freed:"
+ (plist-get-stat "explicitly" "-freed")
+ "tried:"
+ (plist-get-stat "explicitly" "-tried-freed")
+ "")))
+
+ (plist-get plist 'n-gc-total)))))
1.194 +9 -0 XEmacs/xemacs/nt/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/nt/ChangeLog,v
retrieving revision 1.193
retrieving revision 1.194
diff -u -p -r1.193 -r1.194
--- ChangeLog 2005/11/10 15:45:13 1.193
+++ ChangeLog 2005/11/25 01:41:49 1.194
＠＠ -1,3 +1,12 ＠＠
+2005-11-21 Marcus Crestani <crestani(a)xemacs.org>
+
+ Incremental Garbage Collector
+
+ * config.inc.samp: Add NEW_GC option.
+ * xemacs.dsp: Add files gc.c, gc.h, vdb.c, vdb.h, and vdb-win32.c.
+ * xemacs.mak: Add NEW_GC option; if NEW_GC, turn on KKCC and
+ MC_ALLOC.
+
2005-11-08 Marcus Crestani <crestani(a)xemacs.org>
* xemacs.mak:
1.23 +3 -0 XEmacs/xemacs/nt/config.inc.samp
Index: config.inc.samp
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/nt/config.inc.samp,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -p -r1.22 -r1.23
--- config.inc.samp 2005/09/26 08:13:00 1.22
+++ config.inc.samp 2005/11/25 01:41:50 1.23
＠＠ -223,6 +223,9 ＠＠ USE_KKCC=1
# Set this to use the new experimental allocator routines
MC_ALLOC=1
+# Set this to use the new experimental incremental garbage collector routines
+NEW_GC=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
1.8 +20 -0 XEmacs/xemacs/nt/xemacs.dsp
Index: xemacs.dsp
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/nt/xemacs.dsp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -p -r1.7 -r1.8
--- xemacs.dsp 2005/04/08 23:11:07 1.7
+++ xemacs.dsp 2005/11/25 01:41:50 1.8
＠＠ -555,6 +555,14 ＠＠ SOURCE="..\src\free-hook.c"
# End Source File
# Begin Source File
+SOURCE=..\src\gc.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\gc.h
+# End Source File
+# Begin Source File
+
SOURCE=..\src\general.c
# End Source File
# Begin Source File
＠＠ -1336,6 +1344,18 ＠＠ SOURCE=..\src\unexsunos4.c
# Begin Source File
SOURCE=..\src\universe.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\vdb.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\vdb.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\vdb-win32.c
# End Source File
# Begin Source File
1.119 +15 -0 XEmacs/xemacs/nt/xemacs.mak
Index: xemacs.mak
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/nt/xemacs.mak,v
retrieving revision 1.118
retrieving revision 1.119
diff -u -p -r1.118 -r1.119
--- xemacs.mak 2005/11/10 15:45:13 1.118
+++ xemacs.mak 2005/11/25 01:41:50 1.119
＠＠ -218,6 +218,9 ＠＠ USE_KKCC=0
!if !defined(MC_ALLOC)
MC_ALLOC=0
!endif
+!if !defined(NEW_GC)
+NEW_GC=0
+!endif
!if !defined(USE_UNION_TYPE)
USE_UNION_TYPE=0
!endif
＠＠ -639,9 +642,17 ＠＠ OPT_OBJS=$(OPT_OBJS) $(OUTDIR)\dumper.ob
OPT_OBJS=$(OPT_OBJS) $(OUTDIR)\unexnt.obj
!endif
+!if $(NEW_GC)
+OPT_DEFINES=$(OPT_DEFINES) -DNEW_GC
+OPT_OBJS=$(OPT_OBJS) $(OUTDIR)\vdb.obj $(OUTDIR)\vdb-win32.obj
+USE_KKCC=1
+MC_ALLOC=1
+!endif
+
!if $(USE_KKCC)
OPT_DEFINES=$(OPT_DEFINES) -DUSE_KKCC
!endif
+
!if $(MC_ALLOC)
OPT_DEFINES=$(OPT_DEFINES) -DMC_ALLOC
OPT_OBJS=$(OPT_OBJS) $(OUTDIR)\mc-alloc.obj
＠＠ -848,6 +859,7 ＠＠ TEMACS_COMMON_OBJS= \
$(OUTDIR)\fns.obj \
$(OUTDIR)\font-lock.obj \
$(OUTDIR)\frame.obj \
+ $(OUTDIR)\gc.obj \
$(OUTDIR)\general.obj \
$(OUTDIR)\getloadavg.obj \
$(OUTDIR)\glyphs.obj \
＠＠ -1258,6 +1270,9 ＠＠ XEmacs $(XEMACS_VERSION_STRING) $(xemacs
!endif
!if $(MC_ALLOC)
Using new experimental allocator.
+!endif
+!if $(NEW_GC)
+ Using new experimental incremental garbage collector.
!endif
<<NOKEEP
＠echo --------------------------------------------------------------------
1.11 +2 -0 XEmacs/xemacs/src/.cvsignore
Index: .cvsignore
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/.cvsignore,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -p -r1.10 -r1.11
--- .cvsignore 2005/06/28 12:02:42 1.10
+++ .cvsignore 2005/11/25 01:41:52 1.11
＠＠ -30,3 +30,5 ＠＠ REBUILD_AUTOLOADS
dump-size
xemacs.def
xemacs.def.in
+.dbxrc
+.gdbinit
1.892 +325 -0 XEmacs/xemacs/src/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.891
retrieving revision 1.892
diff -u -p -r1.891 -r1.892
--- ChangeLog 2005/11/22 11:24:40 1.891
+++ ChangeLog 2005/11/25 01:41:53 1.892
＠＠ -1,3 +1,328 ＠＠
+2005-11-21 Marcus Crestani <crestani(a)xemacs.org>
+
+ Incremental Garbage Collector
+
+ * .cvsignore: Add .dbxrc and .gdbinit.
+
+ * .dbxrc: Remove.
+ * .dbxrc.in: New, used to generate .dbxrc: If newgc is enabled, do
+ not break on SIGBUS and SIGSEGV.
+ * .gdbinit: Remove.
+ * .gdbinit: New, used to generate .gdbinit: If newgc is enabled,
+ do not break on SIGBUS and SIGSEGV.
+
+ * Makefile.in.in: Add gc.c, newgc_objs and vdb_objs.
+
+ * alloc.c: Move the GC related code to gc.c: marking, gc hooks,
+ garbage_collect_1, GC related Lisp functions and variables. Left
+ in alloc.c are the allocation functions, the definition of
+ lrecords, the sweep functions of the old garbage collector, and
+ root-set code like staticpro and mcpro. Remove
+ lrecord_string_data_stats.
+ * alloc.c (DECREMENT_CONS_COUNTER): Remove call to
+ recompute_need_to_garbage_collect.
+ * alloc.c (init_lrecord_stats): Remove additionally allocated
+ memory statistics, i.e. statistics for string data.
+ * alloc.c (alloc_lrecord_array): New.
+ * alloc.c (free_lrecord): Do not explicitly free during gc. Add
+ recompute_need_to_garbage_collect.
+ * alloc.c (make_compiled_function): Field arguments is now a Lisp
+ object, thus init it to Qnil rather than NULL.
+ * alloc.c (struct string_chars_block):
+ * alloc.c (finalize_string):
+ * alloc.c (struct string_chars):
+ * alloc.c (make_uninit_string):
+ * alloc.c (resize_string):
+ * alloc.c (make_string_nocopy):
+ String data is now a Lisp object. Remove code that handled string
+ data specially.
+ * alloc.c (init_lrecord_stats): Remove lrecord_string_data_stats.
+ * alloc.c (common_init_alloc_early):
+ * alloc.c (init_alloc_once_early):
+ * alloc.c (syms_of_alloc):
+ * alloc.c (vars_of_alloc):
+ * alloc.c (complex_vars_of_alloc):
+ Move init code to gc.c's inizializers.
+
+ * buffer.c:
+ * buffer.c (syms_of_buffer):
+ * buffer.h:
+ * buffer.h (struct buffer_text): Add new Lisp object: buffer_text.
+
+ * bytecode.c:
+ * bytecode.c (make_compiled_function_args):
+ * bytecode.c (optimize_compiled_function):
+ * bytecode.c (mark_compiled_function):
+ * bytecode.c (finalize_compiled_function):
+ * bytecode.c (syms_of_bytecode):
+ * bytecode.h:
+ * bytecode.h (struct compiled_function_args):
+ * bytecode.h (struct Lisp_Compiled_Function): Add new Lisp object:
+ compiled_function_args.
+
+ * config.h.in: Add NEW_GC symbol, add VDB_* symbols, and symbols
+ for functions and structs checked for vdb.
+
+ * console-gtk-impl.h:
+ * console-gtk-impl.h (struct gtk_device):
+ * console-gtk-impl.h (struct gtk_frame):
+ * console-msw-impl.h:
+ * console-msw-impl.h (struct mswindows_device):
+ * console-msw-impl.h (struct msprinter_device):
+ * console-msw-impl.h (struct mswindows_frame):
+ * console-stream-impl.h:
+ * console-stream-impl.h (struct stream_console):
+ * console-stream.c:
+ * console-stream.c (stream_init_console):
+ * console-stream.c (stream_delete_console):
+ * console-stream.h:
+ * console-tty-impl.h:
+ * console-tty-impl.h (struct tty_console):
+ * console-tty-impl.h (struct tty_device):
+ * console-tty.c:
+ * console-tty.c (allocate_tty_console_struct):
+ * console-tty.c (free_tty_console_struct):
+ * console-x-impl.h:
+ * console-x-impl.h (struct x_device):
+ * console-x-impl.h (struct x_frame):
+ * console.c:
+ * console.c (syms_of_console): Add new Lisp objects: tty_console,
+ stream_consle.
+
+ * device-gtk.c:
+ * device-gtk.c (allocate_gtk_device_struct):
+ * device-gtk.c (free_gtk_device_struct):
+ * device-gtk.c (syms_of_device_gtk):
+ * device-msw.c:
+ * device-msw.c (mswindows_init_device):
+ * device-msw.c (mswindows_delete_device):
+ * device-msw.c (msprinter_init_device):
+ * device-msw.c (msprinter_delete_device):
+ * device-msw.c (syms_of_device_mswindows):
+ * device-tty.c:
+ * device-tty.c (free_tty_device_struct):
+ * device-tty.c (syms_of_device_tty):
+ * device-x.c:
+ * device-x.c (allocate_x_device_struct):
+ * device-x.c (free_x_device_struct):
+ * device-x.c (syms_of_device_x):
+ * device.c: Add new Lisp objects: x_device, gtk_device,
+ tty_device, mswindows_device, msprinter_device.
+
+ * dumper.c:
+ * dumper.c (pdump_register_sub): Add XD_LISP_OBJECT_PTR.
+ * dumper.c (pdump_register_object_array): New.
+ * dumper.c (pdump_store_new_pointer_offsets): Add XD_LISP_OBJECT_PTR.
+ * dumper.c (pdump_scan_lisp_objects_by_alignment): Remove assert,
+ XD_LISP_OBJECT_PTR may occur as arrays.
+ * dumper.c (pdump_reloc_one_mc): Add XD_LISP_OBJECT_PTR.
+ * dumper.c (pdump_dump_rtables): Dump arrays.
+ * dumper.c (pdump_load_finish): Store and restore state of
+ allow_incremental_gc. Remove lrecord_string_data_stats.
+
+ * dynarr.c:
+ * dynarr.c (Dynarr_lisp_newf): Special case dynamic Lisp array.
+ * dynarr.c (Dynarr_resize): Special case dynamic Lisp array.
+ * dynarr.c (Dynarr_free): Add dynamic Lisp array.
+
+ * elhash.c:
+ * elhash.c (htentry):
+ * elhash.c (make_general_lisp_hash_table):
+ * elhash.c (Fcopy_hash_table):
+ * elhash.c (resize_hash_table):
+ * elhash.c (pdump_reorganize_hash_table):
+ * elhash.c (init_elhash_once_early):
+ * elhash.h: Add new Lisp object: hash_table_entry. Make
+ hash_table_entries Lisp objects.
+
+ * emacs.c (main_1): Install platform's vdb signal handler, add GC
+ init, add syms of GC and vdb, .
+ * emacs.c: Replace garbage_collect_1 calls with gc_full calls.
+ * emacs.c (fatal_error_signal): With vdb enabled, convert SIGSEGV
+ and SIGBUS to SIGABRT.
+
+ * eval.c (Fsignal): Incremental GC may always run, changes are
+ caught by the write barrier.
+ * eval.c (handle_compiled_function_with_and_rest):
+ * eval.c (funcall_compiled_function):
+ * eval.c (Feval): Invoke incremental GC if need to GC.
+ * eval.c (Ffuncall): Invoke incremental GC if need to GC.
+ * eval.c (run_hook_with_args_in_buffer): Add new Lisp object:
+ compiled_function_args.
+
+ * event-msw.c (mswindows_wnd_proc): Incremental GC may always run,
+ changes are caught by the write barrier.
+ * events.c (reinit_vars_of_events): Vevent_resource now
+ collectible, staticpro it.
+
+ * extents.c:
+ * extents.c (gap_array_marker):
+ * extents.c (gap_array):
+ * extents.c (extent_list_marker):
+ * extents.c (extent_list):
+ * extents.c (stack_of_extents):
+ * extents.c (gap_array_make_gap):
+ * extents.c (gap_array_make_marker):
+ * extents.c (gap_array_delete_marker):
+ * extents.c (gap_array_delete_all_markers):
+ * extents.c (make_gap_array):
+ * extents.c (free_gap_array):
+ * extents.c (extent_list_insert):
+ * extents.c (extent_list_make_marker):
+ * extents.c (extent_list_delete_marker):
+ * extents.c (allocate_extent_list):
+ * extents.c (free_extent_list):
+ * extents.c (finalize_extent_info):
+ * extents.c (flush_cached_extent_info):
+ * extents.c (uninit_buffer_extents):
+ * extents.c (allocate_soe):
+ * extents.c (free_soe):
+ * extents.c (syms_of_extents):
+ * extents.h: Add new Lisp object: gap_array_marker, gap_array,
+ extent_list_marker, extent_list, and stack_of_extents.
+
+ * faces.h:
+ * faces.h (struct face_cachel): Add new Lisp object: face cachel.
+
+ * frame-gtk.c:
+ * frame-gtk.c (allocate_gtk_frame_struct):
+ * frame-gtk.c (gtk_delete_frame):
+ * frame-gtk.c (syms_of_frame_gtk):
+ * frame-msw.c:
+ * frame-msw.c (mswindows_init_frame_1):
+ * frame-msw.c (mswindows_delete_frame):
+ * frame-msw.c (syms_of_frame_mswindows):
+ * frame-x.c:
+ * frame-x.c (allocate_x_frame_struct):
+ * frame-x.c (x_delete_frame):
+ * frame-x.c (syms_of_frame_x):
+ * frame.c:
+ * frame.c (change_frame_size):
+ * frame.c (syms_of_frame): Add new Lisp object: gtk_console,
+ mswindows_console, and x_console.
+
+ * glyphs.c (struct expose_ignore_blocktype):
+ * glyphs.c (check_for_ignored_expose):
+ * glyphs.c (register_ignored_expose):
+ * glyphs.c (reinit_vars_of_glyphs):
+ * glyphs.h:
+ * glyphs.h (struct glyph_cachel):
+ * glyphs.h (struct expose_ignore): Add new Lisp object:
+ glyph_cachel and expose_ignore.
+
+ * lisp.h: Move dynamic array definition down after lrecord
+ inclusion. Add dynamic lisp array macros. Add direct and
+ indirect string data. Add string accessors. Remove
+ lrecord_string_data_stats.
+ * lisp.h (struct Lisp_String_Direct_Data): New.
+ * lisp.h (struct Lisp_String_Indirect_Data): New.
+ * lisp.h (struct Lisp_String): Add indirect flag and Lisp object
+ data.
+
+ * lrecord.h: Remove lrecord_type numbering.
+ * lrecord.h (enum lrecord_type): Add new Lisp objects.
+ * lrecord.h (MC_ALLOC_CALL_FINALIZER): Add GC statistics.
+ * lrecord.h (enum memory_description_type): Add
+ XD_LISP_OBJECT_BLOCK_PTR.
+ * lrecord.h (XD_LISP_DYNARR_DESC): New.
+ * lrecord.h (alloc_lrecord_array): New.
+
+ * mc-alloc.c:
+ * mc-alloc.c (MIN_HEAP_INCREASE):
+ * mc-alloc.c (free_link):
+ * mc-alloc.c (page_header):
+ * mc-alloc.c (FREE_HEAP_PAGES):
+ * mc-alloc.c (PH_BLACK_BIT):
+ * mc-alloc.c (get_mark_bit_index):
+ * mc-alloc.c (add_pages_to_lookup_table):
+ * mc-alloc.c (alloc_bit_array):
+ * mc-alloc.c (get_bit):
+ * mc-alloc.c (set_bit):
+ * mc-alloc.c (USE_PNTR_MARK_BITS):
+ * mc-alloc.c (GET_BIT_WORD):
+ * mc-alloc.c (SET_BIT_WORD):
+ * mc-alloc.c (ZERO_MARK_BITS_PNTR):
+ * mc-alloc.c (alloc_mark_bits):
+ * mc-alloc.c (free_mark_bits):
+ * mc-alloc.c (set_mark_bit):
+ * mc-alloc.c (alloc_page_header):
+ * mc-alloc.c (free_page_header):
+ * mc-alloc.c (get_used_list_index):
+ * mc-alloc.c (get_free_list_index):
+ * mc-alloc.c (install_cell_free_list):
+ * mc-alloc.c (install_page_in_used_list):
+ * mc-alloc.c (remove_page_from_used_list):
+ * mc-alloc.c (allocate_new_page):
+ * mc-alloc.c (mc_alloc_1):
+ * mc-alloc.c (mc_alloc_array):
+ * mc-alloc.c (mc_alloc):
+ * mc-alloc.c (mark_free_list):
+ * mc-alloc.c (finalize_page):
+ * mc-alloc.c (finalize_page_for_disksave):
+ * mc-alloc.c (sweep_page):
+ * mc-alloc.c (mc_free):
+ * mc-alloc.c (mc_realloc_1):
+ * mc-alloc.c (mc_realloc_array):
+ * mc-alloc.c (init_mc_allocator):
+ * mc-alloc.c (Fmc_alloc_memory_usage):
+ * mc-alloc.c (maybe_mark_black):
+ * mc-alloc.h: Add incremental garbage collector support, various
+ cleanups.
+
+ * objects-tty-impl.h:
+ * objects-tty-impl.h (struct tty_color_instance_data):
+ * objects-tty-impl.h (struct tty_font_instance_data):
+ * objects-tty.c:
+ * objects-tty.c (tty_initialize_color_instance):
+ * objects-tty.c (tty_finalize_color_instance):
+ * objects-tty.c (tty_initialize_font_instance):
+ * objects-tty.c (tty_finalize_font_instance):
+ * objects-tty.c (syms_of_objects_tty):
+ * objects.c: New Lisp objects: color_instance_data and
+ font_instance_data.
+
+ * print.c (print_internal): New Lisp object: string_data.
+
+ * specifier.c:
+ * specifier.c (finalize_specifier):
+ * specifier.c (set_specifier_caching):
+ * specifier.c (syms_of_specifier):
+ * specifier.h:
+ * specifier.h (struct specifier_caching): New Lisp object:
+ specifier caching.
+
+ * syntax.c:
+ * syntax.c (init_buffer_syntax_cache):
+ * syntax.c (uninit_buffer_syntax_cache):
+ * syntax.c (syms_of_syntax):
+ * syntax.h:
+ * syntax.h (struct syntax_cache): New Lisp object: syntax_cache.
+
+ * window.c:
+ * window.c (allocate_window):
+ * window.c (make_dummy_parent):
+ * window.c (syms_of_window): New Lisp objects: face_cachel,
+ fache_cachel_dynarr, glyph_cachel, and glyph_cachel_dynarr.
+
+
+ New files:
+ * gc.c: Moved code from alloc.c. Split up garbage_collect_1 in a
+ couple of smaller functions.
+ * gc.h: Incremental Garbage Collector
+
+ * vdb-fake.c: Virtual dirty bit fake implementation.
+ * vdb-mach.c: Virtual dirty bit implementation for Mach systems.
+ * vdb-posix.c: Virtual dirty bit implementation for POSIX systems.
+ * vdb-win32.c: Virtual dirty bit implementation for Win32 systems.
+
+ * vdb.c:
+ * vdb.h: Platform independent virtual dirty bit implementation.
+
+
+ Remove files:
+ * .dbxrc:
+ * .gdbinit: Now generated by configure script.
+
2005-11-22 Malcolm Purvis <malcolmp(a)xemacs.org>
* frame-gtk.c (gtk_internal_frame_property_p):
1.122 +15 -2 XEmacs/xemacs/src/Makefile.in.in
Index: Makefile.in.in
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Makefile.in.in,v
retrieving revision 1.121
retrieving revision 1.122
diff -u -p -r1.121 -r1.122
--- Makefile.in.in 2005/11/22 07:14:44 1.121
+++ Makefile.in.in 2005/11/25 01:41:55 1.122
＠＠ -255,6 +255,19 ＠＠ win32_objs=win32.o intl-win32.o intl-aut
mc_alloc_objs=mc-alloc.o
#endif
+#ifdef NEW_GC
+new_gc_objs=vdb.o
+# if defined (WIN32_ANY) || defined (VDB_WIN32)
+vdb_objs=vdb-win32.o
+# elif defined (VDB_MACH)
+vdb_objs=vdb-mach.o
+# elif defined (VDB_POSIX)
+vdb_objs=vdb-posix.o
+# else /* VDB_FAKE */
+vdb_objs=vdb-fake.o
+# endif
+#endif /* NEW_GC */
+
## lastfile must follow all files whose initialized data areas should
## be dumped as pure by dump-emacs.
＠＠ -273,12 +286,12 ＠＠ objs=\
event-stream.o $(event_unixoid_objs) $(extra_objs) extents.o\
faces.o file-coding.o fileio.o $(LOCK_OBJ) filemode.o floatfns.o fns.o \
font-lock.o frame.o\
- general.o $(gif_objs) glyphs.o glyphs-eimage.o glyphs-shared.o\
+ gc.o general.o $(gif_objs) glyphs.o glyphs-eimage.o glyphs-shared.o\
glyphs-widget.o $(gpm_objs) $(gtk_objs) $(gtk_gui_objs) $(gui_objs) \
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) \
+ $(mc_alloc_objs) $(new_gc_objs) $(vdb_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)\
1.120 +286 -1507 XEmacs/xemacs/src/alloc.c
Index: alloc.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/alloc.c,v
retrieving revision 1.119
retrieving revision 1.120
diff -u -p -r1.119 -r1.120
--- alloc.c 2005/11/13 10:48:02 1.119
+++ alloc.c 2005/11/25 01:41:55 1.120
＠＠ -52,6 +52,7 ＠＠ Boston, MA 02111-1307, USA. */
#include "extents-impl.h"
#include "file-coding.h"
#include "frame-impl.h"
+#include "gc.h"
#include "glyphs.h"
#include "opaque.h"
#include "lstream.h"
＠＠ -62,6 +63,9 ＠＠ Boston, MA 02111-1307, USA. */
#include "sysfile.h"
#include "sysdep.h"
#include "window.h"
+#ifdef NEW_GC
+#include "vdb.h"
+#endif /* NEW_GC */
#include "console-stream.h"
#ifdef DOUG_LEA_MALLOC
＠＠ -70,8 +74,6 ＠＠ Boston, MA 02111-1307, USA. */
EXFUN (Fgarbage_collect, 0);
-static void recompute_need_to_garbage_collect (void);
-
#if 0 /* this is _way_ too slow to be part of the standard debug options */
#if defined(DEBUG_XEMACS) && defined(MULE)
#define VERIFY_STRING_CHARS_INTEGRITY
＠＠ -91,13 +93,6 ＠＠ static Fixnum debug_allocation;
static Fixnum debug_allocation_backtrace_length;
#endif
-/* Number of bytes of consing done since the last gc */
-static EMACS_INT consing_since_gc;
-EMACS_UINT total_consing;
-EMACS_INT total_gc_usage;
-int total_gc_usage_set;
-
-int need_to_garbage_collect;
int need_to_check_c_alloca;
int need_to_signal_post_gc;
int funcall_allocation_flag;
＠＠ -149,6 +144,20 ＠＠ do { \
INCREMENT_CONS_COUNTER_1 (size)
#endif
+#ifdef NEW_GC
+/* The call to recompute_need_to_garbage_collect is moved to
+ free_lrecord, since DECREMENT_CONS_COUNTER is extensively called
+ during sweep and recomputing need_to_garbage_collect all the time
+ is not needed. */
+#define DECREMENT_CONS_COUNTER(size) do { \
+ consing_since_gc -= (size); \
+ total_consing -= (size); \
+ if (profiling_active) \
+ profile_record_unconsing (size); \
+ if (consing_since_gc < 0) \
+ consing_since_gc = 0; \
+} while (0)
+#else /* not NEW_GC */
#define DECREMENT_CONS_COUNTER(size) do { \
consing_since_gc -= (size); \
total_consing -= (size); \
＠＠ -158,51 +167,11 ＠＠ do { \
consing_since_gc = 0; \
recompute_need_to_garbage_collect (); \
} while (0)
+#endif /*not NEW_GC */
-/* Number of bytes of consing since gc before another gc should be done. */
-static EMACS_INT gc_cons_threshold;
-
-/* Percentage of consing of total data size before another GC. */
-static EMACS_INT gc_cons_percentage;
-
-#ifdef ERROR_CHECK_GC
-int always_gc; /* Debugging hack; equivalent to
- (setq gc-cons-thresold -1) */
-#else
-#define always_gc 0
-#endif
-
-/* Nonzero during gc */
-int gc_in_progress;
-
-/* Nonzero means display messages at beginning and end of GC. */
-
-int garbage_collection_messages;
-
-/* Number of times GC has happened at this level or below.
- * Level 0 is most volatile, contrary to usual convention.
- * (Of course, there's only one level at present) */
-EMACS_INT gc_generation_number[1];
-
/* This is just for use by the printer, to allow things to print uniquely */
int lrecord_uid_counter;
-/* Nonzero when calling certain hooks or doing other things where
- a GC would be bad */
-int gc_currently_forbidden;
-
-/* Hooks. */
-Lisp_Object Vpre_gc_hook, Qpre_gc_hook;
-Lisp_Object Vpost_gc_hook, Qpost_gc_hook;
-
-/* "Garbage collecting" */
-Lisp_Object Vgc_message;
-Lisp_Object Vgc_pointer_glyph;
-static const Ascbyte gc_default_message[] = "Garbage collecting";
-Lisp_Object Qgarbage_collecting;
-
-static Lisp_Object QSin_garbage_collection;
-
/* Non-zero means we're in the process of doing the dump */
int purify_flag;
＠＠ -248,7 +217,7 ＠＠ int ignore_malloc_warnings;
#ifndef MC_ALLOC
-static void *breathing_space;
+void *breathing_space;
void
release_breathing_space (void)
＠＠ -282,6 +251,7 ＠＠ malloc_warning (const char *str)
DOESNT_RETURN
memory_full (void)
{
+ fprintf (stderr, "##### M E M O R Y F U L L #####\n");
/* Force a GC next time eval is called.
It's better to loop garbage-collecting (we might reclaim enough
to win) than to loop beeping and barfing "Memory exhausted"
＠＠ -521,33 +491,10 ＠＠ static struct
} lrecord_stats [countof (lrecord_implementations_table)
+ MODULE_DEFINABLE_TYPE_COUNT];
-int lrecord_string_data_instances_in_use;
-int lrecord_string_data_bytes_in_use;
-int lrecord_string_data_bytes_in_use_including_overhead;
-
void
init_lrecord_stats ()
{
xzero (lrecord_stats);
- lrecord_string_data_instances_in_use = 0;
- lrecord_string_data_bytes_in_use = 0;
- lrecord_string_data_bytes_in_use_including_overhead = 0;
-}
-
-void
-inc_lrecord_string_data_stats (Bytecount size)
-{
- lrecord_string_data_instances_in_use++;
- lrecord_string_data_bytes_in_use += size;
- lrecord_string_data_bytes_in_use_including_overhead += size;
-}
-
-void
-dec_lrecord_string_data_stats (Bytecount size)
-{
- lrecord_string_data_instances_in_use--;
- lrecord_string_data_bytes_in_use -= size;
- lrecord_string_data_bytes_in_use_including_overhead -= size;
}
void
＠＠ -581,6 +528,17 ＠＠ dec_lrecord_stats (Bytecount size_includ
DECREMENT_CONS_COUNTER (size);
}
+
+int
+lrecord_stats_heap_size (void)
+{
+ int i;
+ int size = 0;
+ for (i = 0; i < (countof (lrecord_implementations_table)
+ + MODULE_DEFINABLE_TYPE_COUNT); i++)
+ size += lrecord_stats[i].bytes_in_use;
+ return size;
+}
#endif /* not (MC_ALLOC && ALLOC_TYPE_STATS) */
#ifndef MC_ALLOC
＠＠ -613,6 +571,7 ＠＠ alloc_lrecord (Bytecount size,
return lheader;
}
+
void *
noseeum_alloc_lrecord (Bytecount size,
const struct lrecord_implementation *implementation)
＠＠ -634,15 +593,59 ＠＠ noseeum_alloc_lrecord (Bytecount size,
return lheader;
}
+#ifdef NEW_GC
+void *
+alloc_lrecord_array (Bytecount size, int elemcount,
+ const struct lrecord_implementation *implementation)
+{
+ struct lrecord_header *lheader;
+ Rawbyte *start, *stop;
+
+ type_checking_assert
+ ((implementation->static_size == 0 ?
+ implementation->size_in_bytes_method != NULL :
+ implementation->static_size == size));
+
+ lheader = (struct lrecord_header *) mc_alloc_array (size, elemcount);
+ gc_checking_assert (LRECORD_FREE_P (lheader));
+
+ for (start = (Rawbyte *) lheader,
+ stop = ((Rawbyte *) lheader) + (size * elemcount -1);
+ start < stop; start += size)
+ {
+ struct lrecord_header *lh = (struct lrecord_header *) start;
+ set_lheader_implementation (lh, implementation);
+ lh->uid = lrecord_uid_counter++;
+#ifdef ALLOC_TYPE_STATS
+ inc_lrecord_stats (size, lh);
+#endif /* not ALLOC_TYPE_STATS */
+ }
+ INCREMENT_CONS_COUNTER (size * elemcount, implementation->name);
+ return lheader;
+}
+#endif /* NEW_GC */
+
void
free_lrecord (Lisp_Object lrecord)
{
+#ifndef NEW_GC
gc_checking_assert (!gc_in_progress);
+#endif /* not NEW_GC */
gc_checking_assert (!LRECORD_FREE_P (XRECORD_LHEADER (lrecord)));
gc_checking_assert (!XRECORD_LHEADER (lrecord)->free);
+#ifdef NEW_GC
+ GC_STAT_EXPLICITLY_TRIED_FREED;
+ /* Ignore requests to manual free objects while in garbage collection. */
+ if (write_barrier_enabled || gc_in_progress)
+ return;
+
+ GC_STAT_EXPLICITLY_FREED;
+#endif /* NEW_GC */
+
MC_ALLOC_CALL_FINALIZER (XPNTR (lrecord));
mc_free (XPNTR (lrecord));
+ recompute_need_to_garbage_collect ();
}
#else /* not MC_ALLOC */
＠＠ -955,16 +958,6 ＠＠ dbg_eq (Lisp_Object obj1, Lisp_Object ob
remain free for the next 1000 (or whatever) times that
an object of that type is allocated. */
-#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 */
-
#if !defined(HAVE_MMAP) || defined(DOUG_LEA_MALLOC)
/* If we released our reserve (due to running out of memory),
and we have a fair amount free once again,
＠＠ -1832,7 +1825,11 ＠＠ make_compiled_function (void)
f->instructions = Qzero;
f->constants = Qzero;
f->arglist = Qnil;
+#ifdef NEW_GC
+ f->arguments = Qnil;
+#else /* not NEW_GC */
f->args = NULL;
+#endif /* not NEW_GC */
f->max_args = f->min_args = f->args_in_array = 0;
f->doc_and_interactive = Qnil;
#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
＠＠ -2238,8 +2235,12 ＠＠ string_equal (Lisp_Object obj1, Lisp_Obj
}
static const struct memory_description string_description[] = {
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, offsetof (Lisp_String, data_object) },
+#else /* not NEW_GC */
{ XD_BYTECOUNT, offsetof (Lisp_String, size_) },
{ XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data_), XD_INDIRECT(0, 1) },
+#endif /* not NEW_GC */
{ XD_LISP_OBJECT, offsetof (Lisp_String, plist) },
{ XD_END }
};
＠＠ -2310,6 +2311,10 ＠＠ DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH
Lisp_String);
#endif /* not MC_ALLOC */
+#ifdef NEW_GC
+#define STRING_FULLSIZE(size) \
+ ALIGN_SIZE (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_String_Direct_Data, Lisp_Object, data, (size) + 1), sizeof (Lisp_Object *));
+#else /* not NEW_GC */
/* String blocks contain this many useful bytes. */
#define STRING_CHARS_BLOCK_SIZE \
((Bytecount) (8192 - MALLOC_OVERHEAD - \
＠＠ -2341,8 +2346,10 ＠＠ static struct string_chars_block *curren
#define STRING_CHARS_FREE_P(ptr) ((ptr)->string == NULL)
#define MARK_STRING_CHARS_AS_FREE(ptr) ((void) ((ptr)->string = NULL))
+#endif /* not NEW_GC */
#ifdef MC_ALLOC
+#ifndef NEW_GC
static void
finalize_string (void *header, int for_disksave)
{
＠＠ -2350,9 +2357,6 ＠＠ finalize_string (void *header, int for_d
{
Lisp_String *s = (Lisp_String *) header;
Bytecount size = s->size_;
-#ifdef ALLOC_TYPE_STATS
- dec_lrecord_string_data_stats (size);
-#endif /* ALLOC_TYPE_STATS */
if (BIG_STRING_SIZE_P (size))
xfree (s->data_, Ibyte *);
}
＠＠ -2369,9 +2373,58 ＠＠ DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS
string_remprop,
string_plist,
Lisp_String);
+#else /* NEW_GC */
+DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string,
+ 1, /*dumpable-flag*/
+ mark_string, print_string,
+ 0,
+ string_equal, 0,
+ string_description,
+ string_getprop,
+ string_putprop,
+ string_remprop,
+ string_plist,
+ Lisp_String);
+
+
+static const struct memory_description string_direct_data_description[] = {
+ { XD_BYTECOUNT, offsetof (Lisp_String_Indirect_Data, size) },
+ { XD_END }
+};
+static Bytecount
+size_string_direct_data (const void *lheader)
+{
+ return STRING_FULLSIZE (((Lisp_String_Direct_Data *) lheader)->size);
+}
+
+
+DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("string-direct-data",
+ string_direct_data,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ string_direct_data_description,
+ size_string_direct_data,
+ Lisp_String_Direct_Data);
+
+
+static const struct memory_description string_indirect_data_description[] = {
+ { XD_BYTECOUNT, offsetof (Lisp_String_Indirect_Data, size) },
+ { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String_Indirect_Data, data),
+ XD_INDIRECT(0, 1) },
+ { XD_END }
+};
+
+DEFINE_LRECORD_IMPLEMENTATION ("string-indirect-data",
+ string_indirect_data,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ string_indirect_data_description,
+ Lisp_String_Indirect_Data);
+#endif /* NEW_GC */
#endif /* MC_ALLOC */
+#ifndef NEW_GC
struct string_chars
{
Lisp_String *string;
＠＠ -2438,6 +2491,7 ＠＠ allocate_string_chars_struct (Lisp_Objec
return s_chars;
}
+#endif /* not NEW_GC */
#ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN
void
＠＠ -2472,9 +2526,6 ＠＠ make_uninit_string (Bytecount length)
#ifdef MC_ALLOC
s = alloc_lrecord_type (Lisp_String, &lrecord_string);
-#ifdef ALLOC_TYPE_STATS
- inc_lrecord_string_data_stats (length);
-#endif /* ALLOC_TYPE_STATS */
#else /* not MC_ALLOC */
/* Allocate the string header */
ALLOCATE_FIXED_TYPE (string, Lisp_String, s);
＠＠ -2486,10 +2537,16 ＠＠ make_uninit_string (Bytecount length)
ascii-length field, to some non-zero value. We need to zero it. */
XSET_STRING_ASCII_BEGIN (wrap_string (s), 0);
+#ifdef NEW_GC
+ STRING_DATA_OBJECT (s) =
+ wrap_string_direct_data (alloc_lrecord (fullsize,
+ &lrecord_string_direct_data));
+#else /* not NEW_GC */
set_lispstringp_data (s, BIG_STRING_FULLSIZE_P (fullsize)
? allocate_big_string_chars (length + 1)
: allocate_string_chars_struct (wrap_string (s),
fullsize)->chars);
+#endif /* not NEW_GC */
set_lispstringp_length (s, length);
s->plist = Qnil;
＠＠ -2511,7 +2568,11 ＠＠ static void verify_string_chars_integrit
void
resize_string (Lisp_Object s, Bytecount pos, Bytecount delta)
{
+#ifdef NEW_GC
+ Bytecount newfullsize, len;
+#else /* not NEW_GC */
Bytecount oldfullsize, newfullsize;
+#endif /* not NEW_GC */
#ifdef VERIFY_STRING_CHARS_INTEGRITY
verify_string_chars_integrity ();
#endif
＠＠ -2539,6 +2600,23 ＠＠ resize_string (Lisp_Object s, Bytecount
so convert this to the appropriate form. */
pos += -delta;
+#ifdef NEW_GC
+ newfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s) + delta);
+
+ len = XSTRING_LENGTH (s) + 1 - pos;
+
+ if (delta < 0 && pos >= 0)
+ memmove (XSTRING_DATA (s) + pos + delta,
+ XSTRING_DATA (s) + pos, len);
+
+ XSTRING_DATA_OBJECT (s) =
+ wrap_string_direct_data (mc_realloc (XPNTR (XSTRING_DATA_OBJECT (s)),
+ newfullsize));
+ if (delta > 0 && pos >= 0)
+ memmove (XSTRING_DATA (s) + pos + delta, XSTRING_DATA (s) + pos,
+ len);
+
+#else /* NEW_GC */
oldfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s));
newfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s) + delta);
＠＠ -2631,6 +2709,7 ＠＠ resize_string (Lisp_Object s, Bytecount
}
}
}
+#endif /* not NEW_GC */
XSET_STRING_LENGTH (s, XSTRING_LENGTH (s) + delta);
/* If pos < 0, the string won't be zero-terminated.
＠＠ -2852,9 +2931,6 ＠＠ make_string_nocopy (const Ibyte *content
#ifdef MC_ALLOC
s = alloc_lrecord_type (Lisp_String, &lrecord_string);
-#ifdef ALLOC_TYPE_STATS
- inc_lrecord_string_data_stats (length);
-#endif /* ALLOC_TYPE_STATS */
mcpro (wrap_pointer_1 (s)); /* otherwise nocopy_strings get
collected and static data is tried to
be freed. */
＠＠ -2867,8 +2943,18 ＠＠ make_string_nocopy (const Ibyte *content
/* Don't need to XSET_STRING_ASCII_BEGIN() here because it happens in
init_string_ascii_begin(). */
s->plist = Qnil;
+#ifdef NEW_GC
+ set_lispstringp_indirect (s);
+ STRING_DATA_OBJECT (s) =
+ wrap_string_indirect_data
+ (alloc_lrecord_type (Lisp_String_Indirect_Data,
+ &lrecord_string_indirect_data));
+ XSTRING_INDIRECT_DATA_DATA (STRING_DATA_OBJECT (s)) = (Ibyte *) contents;
+ XSTRING_INDIRECT_DATA_SIZE (STRING_DATA_OBJECT (s)) = length;
+#else /* not NEW_GC */
set_lispstringp_data (s, (Ibyte *) contents);
set_lispstringp_length (s, length);
+#endif /* not NEW_GC */
val = wrap_string (s);
init_string_ascii_begin (val);
sledgehammer_check_ascii_begin (val);
＠＠ -3337,899 +3423,118 ＠＠ mcpro (Lisp_Object 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); \
- assert (GCLI_lh->type < (unsigned int) lrecord_type_count); \
- assert (! C_READONLY_RECORD_HEADER_P (GCLI_lh) || \
- (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
-
-
-static const struct memory_description lisp_object_description_1[] = {
- { XD_LISP_OBJECT, 0 },
- { XD_END }
-};
-
-const struct sized_memory_description lisp_object_description = {
- sizeof (Lisp_Object),
- lisp_object_description_1
-};
-#if defined (USE_KKCC) || defined (PDUMP)
+#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;
-/* This function extracts the value of a count variable described somewhere
- else in the description. It is converted corresponding to the type */
-EMACS_INT
-lispdesc_indirect_count_1 (EMACS_INT code,
- const struct memory_description *idesc,
- const void *idata)
-{
- EMACS_INT count;
- const void *irdata;
-
- int line = XD_INDIRECT_VAL (code);
- int delta = XD_INDIRECT_DELTA (code);
-
- irdata = ((char *) idata) +
- lispdesc_indirect_count (idesc[line].offset, idesc, idata);
- switch (idesc[line].type)
- {
- case XD_BYTECOUNT:
- count = * (Bytecount *) irdata;
- break;
- case XD_ELEMCOUNT:
- count = * (Elemcount *) irdata;
- break;
- case XD_HASHCODE:
- count = * (Hashcode *) irdata;
- break;
- case XD_INT:
- count = * (int *) irdata;
- break;
- case XD_LONG:
- count = * (long *) irdata;
- break;
- default:
- stderr_out ("Unsupported count type : %d (line = %d, code = %ld)\n",
- idesc[line].type, line, (long) code);
-#if defined(USE_KKCC) && defined(DEBUG_XEMACS)
- if (gc_in_progress)
- kkcc_backtrace ();
-#endif
-#ifdef PDUMP
- if (in_pdump)
- pdump_backtrace ();
-#endif
- count = 0; /* warning suppression */
- ABORT ();
- }
- count += delta;
- return count;
-}
+/* static int gc_count_total_records_used, gc_count_records_total_size; */
-/* SDESC is a "description map" (basically, a list of offsets used for
- successive indirections) and OBJ is the first object to indirect off of.
- Return the description ultimately found. */
+
+/* stats on lcrecords in use - kinda kludgy */
-const struct sized_memory_description *
-lispdesc_indirect_description_1 (const void *obj,
- const struct sized_memory_description *sdesc)
+static struct
{
- int pos;
-
- for (pos = 0; sdesc[pos].size >= 0; pos++)
- obj = * (const void **) ((const char *) obj + sdesc[pos].size);
-
- return (const struct sized_memory_description *) obj;
-}
-
-/* Compute the size of the data at RDATA, described by a single entry
- DESC1 in a description array. OBJ and DESC are used for
- XD_INDIRECT references. */
+ int instances_in_use;
+ int bytes_in_use;
+ int instances_freed;
+ int bytes_freed;
+ int instances_on_free_list;
+} lcrecord_stats [countof (lrecord_implementations_table)
+ + MODULE_DEFINABLE_TYPE_COUNT];
-static Bytecount
-lispdesc_one_description_line_size (void *rdata,
- const struct memory_description *desc1,
- const void *obj,
- const struct memory_description *desc)
+static void
+tick_lcrecord_stats (const struct lrecord_header *h, int free_p)
{
- union_switcheroo:
- switch (desc1->type)
- {
- case XD_LISP_OBJECT_ARRAY:
- {
- EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj);
- return (val * sizeof (Lisp_Object));
- }
- case XD_LISP_OBJECT:
- case XD_LO_LINK:
- return sizeof (Lisp_Object);
- case XD_OPAQUE_PTR:
- return sizeof (void *);
- case XD_BLOCK_PTR:
- {
- EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj);
- return val * sizeof (void *);
- }
- case XD_BLOCK_ARRAY:
- {
- EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj);
-
- return (val *
- lispdesc_block_size
- (rdata,
- lispdesc_indirect_description (obj, desc1->data2.descr)));
- }
- case XD_OPAQUE_DATA_PTR:
- return sizeof (void *);
- case XD_UNION_DYNAMIC_SIZE:
- {
- /* If an explicit size was given in the first-level structure
- description, use it; else compute size based on current union
- constant. */
- const struct sized_memory_description *sdesc =
- lispdesc_indirect_description (obj, desc1->data2.descr);
- if (sdesc->size)
- return sdesc->size;
- else
- {
- desc1 = lispdesc_process_xd_union (desc1, desc, obj);
- if (desc1)
- goto union_switcheroo;
- break;
- }
- }
- case XD_UNION:
- {
- /* If an explicit size was given in the first-level structure
- description, use it; else compute size based on maximum of all
- possible structures. */
- const struct sized_memory_description *sdesc =
- lispdesc_indirect_description (obj, desc1->data2.descr);
- if (sdesc->size)
- return sdesc->size;
- else
- {
- int count;
- Bytecount max_size = -1, size;
-
- desc1 = sdesc->description;
+ int type_index = h->type;
- for (count = 0; desc1[count].type != XD_END; count++)
- {
- size = lispdesc_one_description_line_size (rdata,
- &desc1[count],
- obj, desc);
- if (size > max_size)
- max_size = size;
- }
- return max_size;
- }
- }
- case XD_ASCII_STRING:
- return sizeof (void *);
- case XD_DOC_STRING:
- return sizeof (void *);
- case XD_INT_RESET:
- return sizeof (int);
- case XD_BYTECOUNT:
- return sizeof (Bytecount);
- case XD_ELEMCOUNT:
- return sizeof (Elemcount);
- case XD_HASHCODE:
- return sizeof (Hashcode);
- case XD_INT:
- return sizeof (int);
- case XD_LONG:
- return sizeof (long);
- default:
- stderr_out ("Unsupported dump type : %d\n", desc1->type);
- ABORT ();
+ if (((struct old_lcrecord_header *) h)->free)
+ {
+ gc_checking_assert (!free_p);
+ lcrecord_stats[type_index].instances_on_free_list++;
}
-
- return 0;
-}
-
-
-/* Return the size of the memory block (NOT necessarily a structure!)
- described by SDESC and pointed to by OBJ. If SDESC records an
- explicit size (i.e. non-zero), it is simply returned; otherwise,
- the size is calculated by the maximum offset and the size of the
- object at that offset, rounded up to the maximum alignment. In
- this case, we may need the object, for example when retrieving an
- "indirect count" of an inlined array (the count is not constant,
- but is specified by one of the elements of the memory block). (It
- is generally not a problem if we return an overly large size -- we
- will simply end up reserving more space than necessary; but if the
- size is too small we could be in serious trouble, in particular
- with nested inlined structures, where there may be alignment
- padding in the middle of a block. #### In fact there is an (at
- least theoretical) problem with an overly large size -- we may
- trigger a protection fault when reading from invalid memory. We
- need to handle this -- perhaps in a stupid but dependable way,
- i.e. by trapping SIGSEGV and SIGBUS.) */
-
-Bytecount
-lispdesc_block_size_1 (const void *obj, Bytecount size,
- const struct memory_description *desc)
-{
- EMACS_INT max_offset = -1;
- int max_offset_pos = -1;
- int pos;
-
- if (size)
- return size;
-
- for (pos = 0; desc[pos].type != XD_END; pos++)
+ else
{
- EMACS_INT offset = lispdesc_indirect_count (desc[pos].offset, desc, obj);
- if (offset == max_offset)
+ Bytecount sz = detagged_lisp_object_size (h);
+
+ if (free_p)
{
- stderr_out ("Two relocatable elements at same offset?\n");
- ABORT ();
+ lcrecord_stats[type_index].instances_freed++;
+ lcrecord_stats[type_index].bytes_freed += sz;
}
- else if (offset > max_offset)
+ else
{
- max_offset = offset;
- max_offset_pos = pos;
+ lcrecord_stats[type_index].instances_in_use++;
+ lcrecord_stats[type_index].bytes_in_use += sz;
}
}
-
- if (max_offset_pos < 0)
- return 0;
-
- {
- Bytecount size_at_max;
- size_at_max =
- lispdesc_one_description_line_size ((char *) obj + max_offset,
- &desc[max_offset_pos], obj, desc);
-
- /* We have no way of knowing the required alignment for this structure,
- so just make it maximally aligned. */
- return MAX_ALIGN_SIZE (max_offset + size_at_max);
- }
}
+#endif /* not MC_ALLOC */
-#endif /* defined (USE_KKCC) || defined (PDUMP) */
+
+#ifndef MC_ALLOC
+/* Free all unmarked records */
+static void
+sweep_lcrecords_1 (struct old_lcrecord_header **prev, int *used)
+{
+ struct old_lcrecord_header *header;
+ int num_used = 0;
+ /* int total_size = 0; */
-#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 old_lcrecord_header *) lheader)->free)
-#endif /* MC_ALLOC */
+ xzero (lcrecord_stats); /* Reset all statistics to 0. */
-#ifdef USE_KKCC
-/* The following functions implement the new mark algorithm.
- They mark objects according to their descriptions. They
- are modeled on the corresponding pdumper procedures. */
+ /* First go through and call all the finalize methods.
+ Then go through and free the objects. There used to
+ be only one loop here, with the call to the finalizer
+ occurring directly before the xfree() below. That
+ is marginally faster but much less safe -- if the
+ finalize method for an object needs to reference any
+ other objects contained within it (and many do),
+ we could easily be screwed by having already freed that
+ other object. */
-#ifdef DEBUG_XEMACS
-/* The backtrace for the KKCC mark functions. */
-#define KKCC_INIT_BT_STACK_SIZE 4096
+ for (header = *prev; header; header = header->next)
+ {
+ struct lrecord_header *h = &(header->lheader);
-typedef struct
-{
- void *obj;
- const struct memory_description *desc;
- int pos;
-} kkcc_bt_stack_entry;
-
-static kkcc_bt_stack_entry *kkcc_bt;
-static int kkcc_bt_stack_size;
-static int kkcc_bt_depth = 0;
+ GC_CHECK_LHEADER_INVARIANTS (h);
-static void
-kkcc_bt_init (void)
-{
- kkcc_bt_depth = 0;
- kkcc_bt_stack_size = KKCC_INIT_BT_STACK_SIZE;
- kkcc_bt = (kkcc_bt_stack_entry *)
- malloc (kkcc_bt_stack_size * sizeof (kkcc_bt_stack_entry));
- if (!kkcc_bt)
- {
- stderr_out ("KKCC backtrace stack init failed for size %d\n",
- kkcc_bt_stack_size);
- ABORT ();
+ if (! MARKED_RECORD_HEADER_P (h) && ! header->free)
+ {
+ if (LHEADER_IMPLEMENTATION (h)->finalizer)
+ LHEADER_IMPLEMENTATION (h)->finalizer (h, 0);
+ }
}
-}
-void
-kkcc_backtrace (void)
-{
- int i;
- stderr_out ("KKCC mark stack backtrace :\n");
- for (i = kkcc_bt_depth - 1; i >= 0; i--)
+ for (header = *prev; header; )
{
- 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)))
+ struct lrecord_header *h = &(header->lheader);
+ if (MARKED_RECORD_HEADER_P (h))
{
- stderr_out (" non Lisp Object");
+ if (! C_READONLY_RECORD_HEADER_P (h))
+ UNMARK_RECORD_HEADER (h);
+ num_used++;
+ /* total_size += n->implementation->size_in_bytes (h);*/
+ /* #### May modify header->next on a C_READONLY lcrecord */
+ prev = &(header->next);
+ header = *prev;
+ tick_lcrecord_stats (h, 0);
}
else
{
- stderr_out (" %s",
- XRECORD_LHEADER_IMPLEMENTATION (obj)->name);
+ struct old_lcrecord_header *next = header->next;
+ *prev = next;
+ tick_lcrecord_stats (h, 1);
+ /* used to call finalizer right here. */
+ xfree (header, struct old_lcrecord_header *);
+ header = next;
}
- stderr_out (" (addr: 0x%x, desc: 0x%x, ",
- (int) kkcc_bt[i].obj,
- (int) kkcc_bt[i].desc);
- if (kkcc_bt[i].pos >= 0)
- stderr_out ("pos: %d)\n", kkcc_bt[i].pos);
- else
- stderr_out ("root set)\n");
- }
-}
-
-static void
-kkcc_bt_stack_realloc (void)
-{
- kkcc_bt_stack_size *= 2;
- kkcc_bt = (kkcc_bt_stack_entry *)
- realloc (kkcc_bt, kkcc_bt_stack_size * sizeof (kkcc_bt_stack_entry));
- if (!kkcc_bt)
- {
- stderr_out ("KKCC backtrace stack realloc failed for size %d\n",
- kkcc_bt_stack_size);
- ABORT ();
}
+ *used = num_used;
+ /* *total = total_size; */
}
-static void
-kkcc_bt_free (void)
-{
- free (kkcc_bt);
- kkcc_bt = 0;
- kkcc_bt_stack_size = 0;
-}
-
-static void
-kkcc_bt_push (void *obj, const struct memory_description *desc,
- int level, int pos)
-{
- kkcc_bt_depth = level;
- kkcc_bt[kkcc_bt_depth].obj = obj;
- kkcc_bt[kkcc_bt_depth].desc = desc;
- kkcc_bt[kkcc_bt_depth].pos = pos;
- kkcc_bt_depth++;
- if (kkcc_bt_depth >= kkcc_bt_stack_size)
- kkcc_bt_stack_realloc ();
-}
-
-#else /* not DEBUG_XEMACS */
-#define kkcc_bt_init()
-#define kkcc_bt_push(obj, desc, level, pos)
-#endif /* not DEBUG_XEMACS */
-
-/* Object memory descriptions are in the lrecord_implementation structure.
- But copying them to a parallel array is much more cache-friendly. */
-const struct memory_description *lrecord_memory_descriptions[countof (lrecord_implementations_table)];
-
-/* the initial stack size in kkcc_gc_stack_entries */
-#define KKCC_INIT_GC_STACK_SIZE 16384
-
-typedef struct
-{
- void *data;
- const struct memory_description *desc;
-#ifdef DEBUG_XEMACS
- int level;
- int pos;
-#endif
-} kkcc_gc_stack_entry;
-
-static kkcc_gc_stack_entry *kkcc_gc_stack_ptr;
-static kkcc_gc_stack_entry *kkcc_gc_stack_top;
-static kkcc_gc_stack_entry *kkcc_gc_stack_last_entry;
-static int kkcc_gc_stack_size;
-
-static void
-kkcc_gc_stack_init (void)
-{
- kkcc_gc_stack_size = KKCC_INIT_GC_STACK_SIZE;
- kkcc_gc_stack_ptr = (kkcc_gc_stack_entry *)
- malloc (kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry));
- if (!kkcc_gc_stack_ptr)
- {
- stderr_out ("stack init failed for size %d\n", kkcc_gc_stack_size);
- ABORT ();
- }
- kkcc_gc_stack_top = kkcc_gc_stack_ptr - 1;
- kkcc_gc_stack_last_entry = kkcc_gc_stack_ptr + kkcc_gc_stack_size - 1;
-}
-
-static void
-kkcc_gc_stack_free (void)
-{
- free (kkcc_gc_stack_ptr);
- kkcc_gc_stack_ptr = 0;
- kkcc_gc_stack_top = 0;
- kkcc_gc_stack_size = 0;
-}
-
-static void
-kkcc_gc_stack_realloc (void)
-{
- int current_offset = (int)(kkcc_gc_stack_top - kkcc_gc_stack_ptr);
- kkcc_gc_stack_size *= 2;
- kkcc_gc_stack_ptr = (kkcc_gc_stack_entry *)
- realloc (kkcc_gc_stack_ptr,
- kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry));
- if (!kkcc_gc_stack_ptr)
- {
- stderr_out ("stack realloc failed for size %d\n", kkcc_gc_stack_size);
- ABORT ();
- }
- kkcc_gc_stack_top = kkcc_gc_stack_ptr + current_offset;
- kkcc_gc_stack_last_entry = kkcc_gc_stack_ptr + kkcc_gc_stack_size - 1;
-}
-
-#define KKCC_GC_STACK_FULL (kkcc_gc_stack_top >= kkcc_gc_stack_last_entry)
-#define KKCC_GC_STACK_EMPTY (kkcc_gc_stack_top < kkcc_gc_stack_ptr)
-
-static void
-#ifdef DEBUG_XEMACS
-kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc,
- int level, int pos)
-#else
-kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc)
-#endif
-{
- if (KKCC_GC_STACK_FULL)
- kkcc_gc_stack_realloc();
- kkcc_gc_stack_top++;
- kkcc_gc_stack_top->data = data;
- kkcc_gc_stack_top->desc = desc;
-#ifdef DEBUG_XEMACS
- kkcc_gc_stack_top->level = level;
- kkcc_gc_stack_top->pos = pos;
-#endif
-}
-
-#ifdef DEBUG_XEMACS
-#define kkcc_gc_stack_push(data, desc, level, pos) \
- kkcc_gc_stack_push_1 (data, desc, level, pos)
-#else
-#define kkcc_gc_stack_push(data, desc, level, pos) \
- kkcc_gc_stack_push_1 (data, desc)
-#endif
-
-static kkcc_gc_stack_entry *
-kkcc_gc_stack_pop (void)
-{
- if (KKCC_GC_STACK_EMPTY)
- return 0;
- kkcc_gc_stack_top--;
- return kkcc_gc_stack_top + 1;
-}
-
-void
-#ifdef DEBUG_XEMACS
-kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos)
-#else
-kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj)
-#endif
-{
- if (XTYPE (obj) == Lisp_Type_Record)
- {
- struct lrecord_header *lheader = XRECORD_LHEADER (obj);
- const struct memory_description *desc;
- GC_CHECK_LHEADER_INVARIANTS (lheader);
- desc = RECORD_DESCRIPTION (lheader);
- if (! MARKED_RECORD_HEADER_P (lheader))
- {
- MARK_RECORD_HEADER (lheader);
- kkcc_gc_stack_push ((void*) lheader, desc, level, pos);
- }
- }
-}
-
-#ifdef DEBUG_XEMACS
-#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \
- kkcc_gc_stack_push_lisp_object_1 (obj, level, pos)
-#else
-#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \
- kkcc_gc_stack_push_lisp_object_1 (obj)
-#endif
-
-#ifdef ERROR_CHECK_GC
-#define KKCC_DO_CHECK_FREE(obj, allow_free) \
-do \
-{ \
- if (!allow_free && XTYPE (obj) == Lisp_Type_Record) \
- { \
- struct lrecord_header *lheader = XRECORD_LHEADER (obj); \
- GC_CHECK_NOT_FREE (lheader); \
- } \
-} while (0)
-#else
-#define KKCC_DO_CHECK_FREE(obj, allow_free)
-#endif
-
-#ifdef ERROR_CHECK_GC
-#ifdef DEBUG_XEMACS
-static void
-mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free,
- int level, int pos)
-#else
-static void
-mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free)
-#endif
-{
- KKCC_DO_CHECK_FREE (obj, allow_free);
- kkcc_gc_stack_push_lisp_object (obj, level, pos);
-}
-
-#ifdef DEBUG_XEMACS
-#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \
- mark_object_maybe_checking_free_1 (obj, allow_free, level, pos)
-#else
-#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \
- mark_object_maybe_checking_free_1 (obj, allow_free)
-#endif
-#else /* not ERROR_CHECK_GC */
-#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \
- kkcc_gc_stack_push_lisp_object (obj, level, pos)
-#endif /* not ERROR_CHECK_GC */
-
-
-/* This function loops all elements of a struct pointer and calls
- mark_with_description with each element. */
-static void
-#ifdef DEBUG_XEMACS
-mark_struct_contents_1 (const void *data,
- const struct sized_memory_description *sdesc,
- int count, int level, int pos)
-#else
-mark_struct_contents_1 (const void *data,
- const struct sized_memory_description *sdesc,
- int count)
-#endif
-{
- int i;
- Bytecount elsize;
- elsize = lispdesc_block_size (data, sdesc);
-
- for (i = 0; i < count; i++)
- {
- kkcc_gc_stack_push (((char *) data) + elsize * i, sdesc->description,
- level, pos);
- }
-}
-
-#ifdef DEBUG_XEMACS
-#define mark_struct_contents(data, sdesc, count, level, pos) \
- mark_struct_contents_1 (data, sdesc, count, level, pos)
-#else
-#define mark_struct_contents(data, sdesc, count, level, pos) \
- mark_struct_contents_1 (data, sdesc, count)
-#endif
-
-/* This function implements the KKCC mark algorithm.
- Instead of calling mark_object, all the alive Lisp_Objects are pushed
- on the kkcc_gc_stack. This function processes all elements on the stack
- according to their descriptions. */
-static void
-kkcc_marking (void)
-{
- kkcc_gc_stack_entry *stack_entry = 0;
- void *data = 0;
- const struct memory_description *desc = 0;
- int pos;
-#ifdef DEBUG_XEMACS
- int level = 0;
- kkcc_bt_init ();
-#endif
-
- while ((stack_entry = kkcc_gc_stack_pop ()) != 0)
- {
- data = stack_entry->data;
- desc = stack_entry->desc;
-#ifdef DEBUG_XEMACS
- level = stack_entry->level + 1;
-#endif
-
- 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];
- const void *rdata =
- (const char *) data + lispdesc_indirect_count (desc1->offset,
- desc, data);
- union_switcheroo:
-
- /* If the flag says don't mark, then don't mark. */
- if ((desc1->flags) & XD_FLAG_NO_KKCC)
- continue;
-
- switch (desc1->type)
- {
- case XD_BYTECOUNT:
- case XD_ELEMCOUNT:
- case XD_HASHCODE:
- case XD_INT:
- case XD_LONG:
- case XD_INT_RESET:
- case XD_LO_LINK:
- case XD_OPAQUE_PTR:
- case XD_OPAQUE_DATA_PTR:
- case XD_ASCII_STRING:
- case XD_DOC_STRING:
- break;
- case XD_LISP_OBJECT:
- {
- const Lisp_Object *stored_obj = (const Lisp_Object *) rdata;
-
- /* Because of the way that tagged objects work (pointers and
- Lisp_Objects have the same representation), XD_LISP_OBJECT
- can be used for untagged pointers. They might be NULL,
- 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);
-#endif /* not MC_ALLOC */
- break;
- }
- case XD_LISP_OBJECT_ARRAY:
- {
- int i;
- EMACS_INT count =
- lispdesc_indirect_count (desc1->data1, desc, data);
-
- for (i = 0; i < count; i++)
- {
- const Lisp_Object *stored_obj =
- (const Lisp_Object *) rdata + i;
-
- 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;
- }
- case XD_BLOCK_PTR:
- {
- EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
- data);
- const struct sized_memory_description *sdesc =
- lispdesc_indirect_description (data, desc1->data2.descr);
- const char *dobj = * (const char **) rdata;
- if (dobj)
- mark_struct_contents (dobj, sdesc, count, level, pos);
- break;
- }
- case XD_BLOCK_ARRAY:
- {
- EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
- data);
- const struct sized_memory_description *sdesc =
- lispdesc_indirect_description (data, desc1->data2.descr);
-
- mark_struct_contents (rdata, sdesc, count, level, pos);
- break;
- }
- case XD_UNION:
- case XD_UNION_DYNAMIC_SIZE:
- desc1 = lispdesc_process_xd_union (desc1, desc, data);
- if (desc1)
- goto union_switcheroo;
- break;
-
- default:
- stderr_out ("Unsupported description type : %d\n", desc1->type);
- kkcc_backtrace ();
- ABORT ();
- }
- }
- }
-#ifdef DEBUG_XEMACS
- kkcc_bt_free ();
-#endif
-}
-#endif /* USE_KKCC */
-
-/* Mark reference to a Lisp_Object. If the object referred to has not been
- seen yet, recursively mark all the references contained in it. */
-
-void
-mark_object (
-#ifdef USE_KKCC
- Lisp_Object UNUSED (obj)
-#else
- Lisp_Object obj
-#endif
- )
-{
-#ifdef USE_KKCC
- /* this code should never be reached when configured for KKCC */
- stderr_out ("KKCC: Invalid mark_object call.\n");
- stderr_out ("Replace mark_object with kkcc_gc_stack_push_lisp_object.\n");
- ABORT ();
-#else /* not USE_KKCC */
-
- tail_recurse:
-
- /* Checks we used to perform */
- /* if (EQ (obj, Qnull_pointer)) return; */
- /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return; */
- /* if (PURIFIED (XPNTR (obj))) return; */
-
- if (XTYPE (obj) == Lisp_Type_Record)
- {
- struct lrecord_header *lheader = XRECORD_LHEADER (obj);
-
- GC_CHECK_LHEADER_INVARIANTS (lheader);
-
- /* We handle this separately, above, so we can mark free objects */
- GC_CHECK_NOT_FREE (lheader);
-
- /* All c_readonly objects have their mark bit set,
- so that we only need to check the mark bit here. */
- if (! MARKED_RECORD_HEADER_P (lheader))
- {
- MARK_RECORD_HEADER (lheader);
-
- if (RECORD_MARKER (lheader))
- {
- obj = RECORD_MARKER (lheader) (obj);
- if (!NILP (obj)) goto tail_recurse;
- }
- }
- }
-#endif /* not KKCC */
-}
-
-
-#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;
-
-/* static int gc_count_total_records_used, gc_count_records_total_size; */
-
-
-/* stats on lcrecords in use - kinda kludgy */
-
-static struct
-{
- int instances_in_use;
- int bytes_in_use;
- int instances_freed;
- int bytes_freed;
- int instances_on_free_list;
-} lcrecord_stats [countof (lrecord_implementations_table)
- + MODULE_DEFINABLE_TYPE_COUNT];
-
-static void
-tick_lcrecord_stats (const struct lrecord_header *h, int free_p)
-{
- int type_index = h->type;
-
- if (((struct old_lcrecord_header *) h)->free)
- {
- gc_checking_assert (!free_p);
- lcrecord_stats[type_index].instances_on_free_list++;
- }
- else
- {
- Bytecount sz = detagged_lisp_object_size (h);
-
- if (free_p)
- {
- lcrecord_stats[type_index].instances_freed++;
- lcrecord_stats[type_index].bytes_freed += sz;
- }
- else
- {
- lcrecord_stats[type_index].instances_in_use++;
- lcrecord_stats[type_index].bytes_in_use += sz;
- }
- }
-}
-#endif /* not MC_ALLOC */
-
-
-#ifndef MC_ALLOC
-/* Free all unmarked records */
-static void
-sweep_lcrecords_1 (struct old_lcrecord_header **prev, int *used)
-{
- struct old_lcrecord_header *header;
- int num_used = 0;
- /* int total_size = 0; */
-
- xzero (lcrecord_stats); /* Reset all statistics to 0. */
-
- /* First go through and call all the finalize methods.
- Then go through and free the objects. There used to
- be only one loop here, with the call to the finalizer
- occurring directly before the xfree() below. That
- is marginally faster but much less safe -- if the
- finalize method for an object needs to reference any
- other objects contained within it (and many do),
- we could easily be screwed by having already freed that
- other object. */
-
- for (header = *prev; header; header = header->next)
- {
- struct lrecord_header *h = &(header->lheader);
-
- GC_CHECK_LHEADER_INVARIANTS (h);
-
- if (! MARKED_RECORD_HEADER_P (h) && ! header->free)
- {
- if (LHEADER_IMPLEMENTATION (h)->finalizer)
- LHEADER_IMPLEMENTATION (h)->finalizer (h, 0);
- }
- }
-
- for (header = *prev; header; )
- {
- struct lrecord_header *h = &(header->lheader);
- if (MARKED_RECORD_HEADER_P (h))
- {
- if (! C_READONLY_RECORD_HEADER_P (h))
- UNMARK_RECORD_HEADER (h);
- num_used++;
- /* total_size += n->implementation->size_in_bytes (h);*/
- /* #### May modify header->next on a C_READONLY lcrecord */
- prev = &(header->next);
- header = *prev;
- tick_lcrecord_stats (h, 0);
- }
- else
- {
- struct old_lcrecord_header *next = header->next;
- *prev = next;
- tick_lcrecord_stats (h, 1);
- /* used to call finalizer right here. */
- xfree (header, struct old_lcrecord_header *);
- header = next;
- }
- }
- *used = num_used;
- /* *total = total_size; */
-}
-
/* And the Lord said: Thou shalt use the `c-backslash-region' command
to make macros prettier. */
＠＠ -4795,9 +4100,10 ＠＠ verify_string_chars_integrity (void)
#endif /* defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) */
+#ifndef NEW_GC
/* Compactify string chars, relocating the reference to each --
free any empty string_chars_block we see. */
-static void
+void
compact_string_chars (void)
{
struct string_chars_block *to_sb = first_string_chars_block;
＠＠ -4893,6 +4199,7 ＠＠ compact_string_chars (void)
current_string_chars_block->next = 0;
}
}
+#endif /* not NEW_GC */
#ifndef MC_ALLOC
#if 1 /* Hack to debug missing purecopy's */
＠＠ -4953,29 +4260,10 ＠＠ sweep_strings (void)
gc_count_short_string_total_size = num_small_bytes;
}
#endif /* not MC_ALLOC */
-
-/* I hate duplicating all this crap! */
-int
-marked_p (Lisp_Object obj)
-{
- /* Checks we used to perform. */
- /* if (EQ (obj, Qnull_pointer)) return 1; */
- /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1; */
- /* if (PURIFIED (XPNTR (obj))) return 1; */
-
- if (XTYPE (obj) == Lisp_Type_Record)
- {
- struct lrecord_header *lheader = XRECORD_LHEADER (obj);
-
- GC_CHECK_LHEADER_INVARIANTS (lheader);
-
- return MARKED_RECORD_HEADER_P (lheader);
- }
- return 1;
-}
-static void
-gc_sweep (void)
+#ifndef NEW_GC
+void
+gc_sweep_1 (void)
{
#ifdef MC_ALLOC
compact_string_chars ();
＠＠ -5064,6 +4352,7 ＠＠ gc_sweep (void)
#endif
#endif /* not MC_ALLOC */
}
+#endif /* not NEW_GC */
/* Clearing for disksave. */
＠＠ -5101,11 +4390,16 ＠＠ disksave_object_finalization (void)
#endif
Vshell_file_name = Qnil;
+#ifdef NEW_GC
+ gc_full ();
+#else /* not NEW_GC */
garbage_collect_1 ();
+#endif /* not NEW_GC */
/* Run the disksave finalization methods of all live objects. */
disksave_object_finalization_1 ();
+#ifndef NEW_GC
/* Zero out the uninitialized (really, unused) part of the containers
for the live strings. */
{
＠＠ -5122,405 +4416,12 ＠＠ disksave_object_finalization (void)
}
}
}
+#endif /* not NEW_GC */
/* There, that ought to be enough... */
}
-
-int
-begin_gc_forbidden (void)
-{
- return internal_bind_int (&gc_currently_forbidden, 1);
-}
-
-void
-end_gc_forbidden (int count)
-{
- unbind_to (count);
-}
-
-/* Maybe we want to use this when doing a "panic" gc after memory_full()? */
-static int gc_hooks_inhibited;
-
-struct post_gc_action
-{
- void (*fun) (void *);
- void *arg;
-};
-
-typedef struct post_gc_action post_gc_action;
-
-typedef struct
-{
- Dynarr_declare (post_gc_action);
-} post_gc_action_dynarr;
-
-static post_gc_action_dynarr *post_gc_actions;
-
-/* Register an action to be called at the end of GC.
- gc_in_progress is 0 when this is called.
- This is used when it is discovered that an action needs to be taken,
- but it's during GC, so it's not safe. (e.g. in a finalize method.)
-
- As a general rule, do not use Lisp objects here.
- And NEVER signal an error.
-*/
-
-void
-register_post_gc_action (void (*fun) (void *), void *arg)
-{
- post_gc_action action;
-
- if (!post_gc_actions)
- post_gc_actions = Dynarr_new (post_gc_action);
-
- action.fun = fun;
- action.arg = arg;
-
- Dynarr_add (post_gc_actions, action);
-}
-
-static void
-run_post_gc_actions (void)
-{
- int i;
-
- if (post_gc_actions)
- {
- for (i = 0; i < Dynarr_length (post_gc_actions); i++)
- {
- post_gc_action action = Dynarr_at (post_gc_actions, i);
- (action.fun) (action.arg);
- }
-
- Dynarr_reset (post_gc_actions);
- }
-}
-
-
-void
-garbage_collect_1 (void)
-{
-#if MAX_SAVE_STACK > 0
- char stack_top_variable;
- extern char *stack_bottom;
-#endif
- struct frame *f;
- int speccount;
- int cursor_changed;
- Lisp_Object pre_gc_cursor;
- struct gcpro gcpro1;
- PROFILE_DECLARE ();
-
- assert (!in_display || gc_currently_forbidden);
-
- if (gc_in_progress
- || gc_currently_forbidden
- || in_display
- || preparing_for_armageddon)
- return;
-
- PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection);
-
- /* We used to call selected_frame() here.
-
- The following functions cannot be called inside GC
- so we move to after the above tests. */
- {
- Lisp_Object frame;
- Lisp_Object device = Fselected_device (Qnil);
- if (NILP (device)) /* Could happen during startup, eg. if always_gc */
- return;
- frame = Fselected_frame (device);
- if (NILP (frame))
- invalid_state ("No frames exist on device", device);
- f = XFRAME (frame);
- }
-
- pre_gc_cursor = Qnil;
- cursor_changed = 0;
-
- GCPRO1 (pre_gc_cursor);
-
- /* Very important to prevent GC during any of the following
- stuff that might run Lisp code; otherwise, we'll likely
- have infinite GC recursion. */
- speccount = begin_gc_forbidden ();
-
- need_to_signal_post_gc = 0;
- recompute_funcall_allocation_flag ();
-
- if (!gc_hooks_inhibited)
- run_hook_trapping_problems
- (Qgarbage_collecting, Qpre_gc_hook,
- INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
-
- /* Now show the GC cursor/message. */
- if (!noninteractive)
- {
- if (FRAME_WIN_P (f))
- {
- Lisp_Object frame = wrap_frame (f);
- Lisp_Object cursor = glyph_image_instance (Vgc_pointer_glyph,
- FRAME_SELECTED_WINDOW (f),
- ERROR_ME_NOT, 1);
- pre_gc_cursor = f->pointer;
- if (POINTER_IMAGE_INSTANCEP (cursor)
- /* don't change if we don't know how to change back. */
- && POINTER_IMAGE_INSTANCEP (pre_gc_cursor))
- {
- cursor_changed = 1;
- Fset_frame_pointer (frame, cursor);
- }
- }
-
- /* Don't print messages to the stream device. */
- if (!cursor_changed && !FRAME_STREAM_P (f))
- {
- if (garbage_collection_messages)
- {
- Lisp_Object args[2], whole_msg;
- args[0] = (STRINGP (Vgc_message) ? Vgc_message :
- build_msg_string (gc_default_message));
- args[1] = build_string ("...");
- whole_msg = Fconcat (2, args);
- echo_area_message (f, (Ibyte *) 0, whole_msg, 0, -1,
- Qgarbage_collecting);
- }
- }
- }
-
- /***** Now we actually start the garbage collection. */
-
- gc_in_progress = 1;
- inhibit_non_essential_conversion_operations = 1;
-
- gc_generation_number[0]++;
-
-#if MAX_SAVE_STACK > 0
-
- /* Save a copy of the contents of the stack, for debugging. */
- if (!purify_flag)
- {
- /* Static buffer in which we save a copy of the C stack at each GC. */
- static char *stack_copy;
- static Bytecount stack_copy_size;
-
- ptrdiff_t stack_diff = &stack_top_variable - stack_bottom;
- Bytecount stack_size = (stack_diff > 0 ? stack_diff : -stack_diff);
- if (stack_size < MAX_SAVE_STACK)
- {
- if (stack_copy_size < stack_size)
- {
- stack_copy = (char *) xrealloc (stack_copy, stack_size);
- stack_copy_size = stack_size;
- }
-
- memcpy (stack_copy,
- stack_diff > 0 ? stack_bottom : &stack_top_variable,
- stack_size);
- }
- }
-#endif /* MAX_SAVE_STACK > 0 */
-
- /* Do some totally ad-hoc resource clearing. */
- /* #### generalize this? */
- clear_event_resource ();
- cleanup_specifiers ();
- cleanup_buffer_undo_lists ();
-
- /* Mark all the special slots that serve as the roots of accessibility. */
-
-#ifdef USE_KKCC
- /* initialize kkcc stack */
- kkcc_gc_stack_init();
-#define mark_object(obj) kkcc_gc_stack_push_lisp_object (obj, 0, -1)
-#endif /* USE_KKCC */
-
- { /* staticpro() */
- Lisp_Object **p = Dynarr_begin (staticpros);
- Elemcount count;
- for (count = Dynarr_length (staticpros); count; count--)
- mark_object (**p++);
- }
-
- { /* staticpro_nodump() */
- Lisp_Object **p = Dynarr_begin (staticpros_nodump);
- Elemcount count;
- for (count = Dynarr_length (staticpros_nodump); count; count--)
- 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;
- for (tail = gcprolist; tail; tail = tail->next)
- for (i = 0; i < tail->nvars; i++)
- mark_object (tail->var[i]);
- }
-
- { /* specbind() */
- struct specbinding *bind;
- for (bind = specpdl; bind != specpdl_ptr; bind++)
- {
- mark_object (bind->symbol);
- mark_object (bind->old_value);
- }
- }
-
- {
- struct catchtag *c;
- for (c = catchlist; c; c = c->next)
- {
- mark_object (c->tag);
- mark_object (c->val);
- mark_object (c->actual_tag);
- mark_object (c->backtrace);
- }
- }
-
- {
- struct backtrace *backlist;
- for (backlist = backtrace_list; backlist; backlist = backlist->next)
- {
- int nargs = backlist->nargs;
- int i;
-
- mark_object (*backlist->function);
- if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */
- /* might be fake (internal profiling entry) */
- && backlist->args)
- mark_object (backlist->args[0]);
- else
- for (i = 0; i < nargs; i++)
- mark_object (backlist->args[i]);
- }
- }
-
- mark_profiling_info ();
-
- /* OK, now do the after-mark stuff. This is for things that
- are only marked when something else is marked (e.g. weak hash tables).
- There may be complex dependencies between such objects -- e.g.
- a weak hash table might be unmarked, but after processing a later
- weak hash table, the former one might get marked. So we have to
- iterate until nothing more gets marked. */
-#ifdef USE_KKCC
- kkcc_marking ();
-#endif /* USE_KKCC */
- init_marking_ephemerons ();
- while (finish_marking_weak_hash_tables () > 0 ||
- finish_marking_weak_lists () > 0 ||
- continue_marking_ephemerons () > 0)
-#ifdef USE_KKCC
- {
- kkcc_marking ();
- }
-#else /* NOT USE_KKCC */
- ;
-#endif /* USE_KKCC */
-
- /* At this point, we know which objects need to be finalized: we
- still need to resurrect them */
-
- while (finish_marking_ephemerons () > 0 ||
- finish_marking_weak_lists () > 0 ||
- finish_marking_weak_hash_tables () > 0)
-#ifdef USE_KKCC
- {
- kkcc_marking ();
- }
- kkcc_gc_stack_free ();
-#undef mark_object
-#else /* NOT USE_KKCC */
- ;
-#endif /* USE_KKCC */
-
- /* And prune (this needs to be called after everything else has been
- marked and before we do any sweeping). */
- /* #### this is somewhat ad-hoc and should probably be an object
- method */
- prune_weak_hash_tables ();
- prune_weak_lists ();
- prune_specifiers ();
- prune_syntax_tables ();
-
- prune_ephemerons ();
- prune_weak_boxes ();
-
- gc_sweep ();
-
- consing_since_gc = 0;
-#ifndef DEBUG_XEMACS
- /* Allow you to set it really fucking low if you really want ... */
- if (gc_cons_threshold < 10000)
- gc_cons_threshold = 10000;
-#endif
- recompute_need_to_garbage_collect ();
-
- inhibit_non_essential_conversion_operations = 0;
- gc_in_progress = 0;
-
- run_post_gc_actions ();
-
- /******* End of garbage collection ********/
-
- /* Now remove the GC cursor/message */
- if (!noninteractive)
- {
- if (cursor_changed)
- Fset_frame_pointer (wrap_frame (f), pre_gc_cursor);
- else if (!FRAME_STREAM_P (f))
- {
- /* Show "...done" only if the echo area would otherwise be empty. */
- if (NILP (clear_echo_area (selected_frame (),
- Qgarbage_collecting, 0)))
- {
- if (garbage_collection_messages)
- {
- Lisp_Object args[2], whole_msg;
- args[0] = (STRINGP (Vgc_message) ? Vgc_message :
- build_msg_string (gc_default_message));
- args[1] = build_msg_string ("... done");
- whole_msg = Fconcat (2, args);
- echo_area_message (selected_frame (), (Ibyte *) 0,
- whole_msg, 0, -1,
- Qgarbage_collecting);
- }
- }
- }
- }
-
- /* now stop inhibiting GC */
- unbind_to (speccount);
-
-#ifndef MC_ALLOC
- if (!breathing_space)
- {
- breathing_space = malloc (4096 - MALLOC_OVERHEAD);
- }
-#endif /* not MC_ALLOC */
-
- UNGCPRO;
-
- need_to_signal_post_gc = 1;
- funcall_allocation_flag = 1;
-
- PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection);
-
- return;
-}
-
#ifdef ALLOC_TYPE_STATS
static Lisp_Object
＠＠ -5573,13 +4474,6 ＠＠ object_memory_usage_stats (int set_total
pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
}
}
- pl = gc_plist_hack ("string-data-storage-including-overhead",
- lrecord_string_data_bytes_in_use_including_overhead, pl);
- pl = gc_plist_hack ("string-data-storage-additional",
- lrecord_string_data_bytes_in_use, pl);
- pl = gc_plist_hack ("string-data-used",
- lrecord_string_data_instances_in_use, pl);
- tgu_val += lrecord_string_data_bytes_in_use_including_overhead;
#else /* not MC_ALLOC */
＠＠ -5720,7 +4614,11 ＠＠ Garbage collection happens automatically
())
{
/* Record total usage for purposes of determining next GC */
+#ifdef NEW_GC
+ gc_full ();
+#else /* not NEW_GC */
garbage_collect_1 ();
+#endif /* not NEW_GC */
/* This will get set to 1, and total_gc_usage computed, as part of the
call to object_memory_usage_stats() -- if ALLOC_TYPE_STATS is enabled. */
＠＠ -5819,28 +4717,6 ＠＠ recompute_funcall_allocation_flag (void)
need_to_signal_post_gc;
}
-/* True if it's time to garbage collect now. */
-static void
-recompute_need_to_garbage_collect (void)
-{
- if (always_gc)
- need_to_garbage_collect = 1;
- else
- need_to_garbage_collect =
- (consing_since_gc > gc_cons_threshold
- &&
-#if 0 /* #### implement this better */
- (100 * consing_since_gc) / total_data_usage () >=
- gc_cons_percentage
-#else
- (!total_gc_usage_set ||
- (100 * consing_since_gc) / total_gc_usage >=
- gc_cons_percentage)
-#endif
- );
- recompute_funcall_allocation_flag ();
-}
-
int
object_dead_p (Lisp_Object obj)
＠＠ -6007,11 +4883,9 ＠＠ common_init_alloc_early (void)
Qnull_pointer = wrap_pointer_1 (0);
#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 */
＠＠ -6023,7 +4897,9 ＠＠ common_init_alloc_early (void)
mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */
#endif
#endif
+#ifndef NEW_GC
init_string_chars_alloc ();
+#endif /* not NEW_GC */
#ifndef MC_ALLOC
init_string_alloc ();
init_string_chars_alloc ();
＠＠ -6081,26 +4957,15 ＠＠ common_init_alloc_early (void)
#endif /* MC_ALLOC */
consing_since_gc = 0;
- need_to_garbage_collect = always_gc;
need_to_check_c_alloca = 0;
funcall_allocation_flag = 0;
funcall_alloca_count = 0;
-#if 1
- gc_cons_threshold = 2000000; /* XEmacs change */
-#else
- gc_cons_threshold = 15000; /* debugging */
-#endif
- gc_cons_percentage = 40; /* #### what is optimal? */
- total_gc_usage_set = 0;
lrecord_uid_counter = 259;
#ifndef MC_ALLOC
debug_string_purity = 0;
#endif /* not MC_ALLOC */
- gc_currently_forbidden = 0;
- gc_hooks_inhibited = 0;
-
#ifdef ERROR_CHECK_TYPES
ERROR_ME.really_unlikely_name_to_have_accidentally_in_a_non_errb_structure =
666;
＠＠ -6167,6 +5032,10 ＠＠ init_alloc_once_early (void)
INIT_LRECORD_IMPLEMENTATION (cons);
INIT_LRECORD_IMPLEMENTATION (vector);
INIT_LRECORD_IMPLEMENTATION (string);
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (string_indirect_data);
+ INIT_LRECORD_IMPLEMENTATION (string_direct_data);
+#endif /* NEW_GC */
#ifndef MC_ALLOC
INIT_LRECORD_IMPLEMENTATION (lcrecord_list);
INIT_LRECORD_IMPLEMENTATION (free);
＠＠ -6200,8 +5069,6 ＠＠ init_alloc_once_early (void)
void
syms_of_alloc (void)
{
- DEFSYMBOL (Qpre_gc_hook);
- DEFSYMBOL (Qpost_gc_hook);
DEFSYMBOL (Qgarbage_collecting);
DEFSUBR (Fcons);
＠＠ -6232,49 +5099,6 ＠＠ syms_of_alloc (void)
void
vars_of_alloc (void)
{
- QSin_garbage_collection = build_msg_string ("(in garbage collection)");
- staticpro (&QSin_garbage_collection);
-
- DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold /*
-*Number of bytes of consing between garbage collections.
-\"Consing\" is a misnomer in that this actually counts allocation
-of all different kinds of objects, not just conses.
-Garbage collection can happen automatically once this many bytes have been
-allocated since the last garbage collection. All data types count.
-
-Garbage collection happens automatically when `eval' or `funcall' are
-called. (Note that `funcall' is called implicitly as part of evaluation.)
-By binding this temporarily to a large number, you can effectively
-prevent garbage collection during a part of the program.
-
-Normally, you cannot set this value less than 10,000 (if you do, it is
-automatically reset during the next garbage collection). However, if
-XEmacs was compiled with DEBUG_XEMACS, this does not happen, allowing
-you to set this value very low to track down problems with insufficient
-GCPRO'ing. If you set this to a negative number, garbage collection will
-happen at *EVERY* call to `eval' or `funcall'. This is an extremely
-effective way to check GCPRO problems, but be warned that your XEmacs
-will be unusable! You almost certainly won't have the patience to wait
-long enough to be able to set it back.
-
-See also `consing-since-gc' and `gc-cons-percentage'.
-*/ );
-
- DEFVAR_INT ("gc-cons-percentage", &gc_cons_percentage /*
-*Percentage of memory allocated between garbage collections.
-
-Garbage collection will happen if this percentage of the total amount of
-memory used for data (see `lisp-object-memory-usage') has been allocated
-since the last garbage collection. However, it will not happen if less
-than `gc-cons-threshold' bytes have been allocated -- this sets an absolute
-minimum in case very little data has been allocated or the percentage is
-set very low. Set this to 0 to have garbage collection always happen after
-`gc-cons-threshold' bytes have been allocated, regardless of current memory
-usage.
-
-See also `consing-since-gc' and `gc-cons-threshold'.
-*/ );
-
#ifdef DEBUG_XEMACS
DEFVAR_INT ("debug-allocation", &debug_allocation /*
If non-zero, print out information to stderr about all objects allocated.
＠＠ -6293,49 +5117,4 ＠＠ Length (in stack frames) of short backtr
Non-nil means loading Lisp code in order to dump an executable.
This means that certain objects should be allocated in readonly space.
*/ );
-
- DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages /*
- Non-nil means display messages at start and end of garbage collection.
-*/ );
- garbage_collection_messages = 0;
-
- DEFVAR_LISP ("pre-gc-hook", &Vpre_gc_hook /*
-Function or functions to be run just before each garbage collection.
-Interrupts, garbage collection, and errors are inhibited while this hook
-runs, so be extremely careful in what you add here. In particular, avoid
-consing, and do not interact with the user.
-*/ );
- Vpre_gc_hook = Qnil;
-
- DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook /*
-Function or functions to be run just after each garbage collection.
-Interrupts, garbage collection, and errors are inhibited while this hook
-runs. Each hook is called with one argument which is an alist with
-finalization data.
-*/ );
- Vpost_gc_hook = Qnil;
-
- DEFVAR_LISP ("gc-message", &Vgc_message /*
-String to print to indicate that a garbage collection is in progress.
-This is printed in the echo area. If the selected frame is on a
-window system and `gc-pointer-glyph' specifies a value (i.e. a pointer
-image instance) in the domain of the selected frame, the mouse pointer
-will change instead of this message being printed.
-*/ );
- Vgc_message = build_string (gc_default_message);
-
- DEFVAR_LISP ("gc-pointer-glyph", &Vgc_pointer_glyph /*
-Pointer glyph used to indicate that a garbage collection is in progress.
-If the selected window is on a window system and this glyph specifies a
-value (i.e. a pointer image instance) in the domain of the selected
-window, the pointer will be changed as specified during garbage collection.
-Otherwise, a message will be printed in the echo area, as controlled
-by `gc-message'.
-*/ );
-}
-
-void
-complex_vars_of_alloc (void)
-{
- Vgc_pointer_glyph = Fmake_glyph_internal (Qpointer);
}
1.74 +17 -0 XEmacs/xemacs/src/buffer.c
Index: buffer.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/buffer.c,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -p -r1.73 -r1.74
--- buffer.c 2005/10/25 08:32:47 1.73
+++ buffer.c 2005/11/25 01:41:56 1.74
＠＠ -233,6 +233,14 ＠＠ static const struct memory_description b
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("buffer-text", buffer_text,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ buffer_text_description_1,
+ Lisp_Buffer_Text);
+#endif /* NEW_GC */
+
static const struct sized_memory_description buffer_text_description = {
sizeof (struct buffer_text),
buffer_text_description_1
＠＠ -244,10 +252,16 ＠＠ static const struct memory_description b
{ XD_LISP_OBJECT, offsetof (struct buffer, extent_info) },
+#ifdef NEW_GC
+ { XD_BLOCK_PTR, offsetof (struct buffer, text),
+ 1, { &buffer_text_description } },
+ { XD_LISP_OBJECT, offsetof (struct buffer, syntax_cache) },
+#else /* not NEW_GC */
{ XD_BLOCK_PTR, offsetof (struct buffer, text),
1, { &buffer_text_description } },
{ XD_BLOCK_PTR, offsetof (struct buffer, syntax_cache),
1, { &syntax_cache_description } },
+#endif /* not NEW_GC */
{ XD_LISP_OBJECT, offsetof (struct buffer, indirect_children) },
{ XD_LISP_OBJECT, offsetof (struct buffer, base_buffer) },
＠＠ -1889,6 +1903,9 ＠＠ void
syms_of_buffer (void)
{
INIT_LRECORD_IMPLEMENTATION (buffer);
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (buffer_text);
+#endif /* NEW_GC */
DEFSYMBOL (Qbuffer_live_p);
DEFSYMBOL (Qbuffer_or_string_p);
1.34 +17 -0 XEmacs/xemacs/src/buffer.h
Index: buffer.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/buffer.h,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -p -r1.33 -r1.34
--- buffer.h 2005/10/24 10:07:34 1.33
+++ buffer.h 2005/11/25 01:41:56 1.34
＠＠ -79,6 +79,9 ＠＠ Boston, MA 02111-1307, USA. */
struct buffer_text
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
Ibyte *beg; /* Actual address of buffer contents. */
Bytebpos gpt; /* Index of gap in buffer. */
Charbpos bufgpt; /* Equivalent as a Charbpos. */
＠＠ -137,6 +140,20 ＠＠ struct buffer_text
/* Change data that goes with the text. */
struct buffer_text_change_data *changes;
};
+
+#ifdef NEW_GC
+typedef struct buffer_text Lisp_Buffer_Text;
+
+DECLARE_LRECORD (buffer_text, Lisp_Buffer_Text);
+
+#define XBUFFER_TEXT(x) \
+ XRECORD (x, buffer_text, Lisp_Buffer_Text)
+#define wrap_buffer_text(p) wrap_record (p, buffer_text)
+#define BUFFER_TEXT_P(x) RECORDP (x, buffer_text)
+#define CHECK_BUFFER_TEXT(x) CHECK_RECORD (x, buffer_text)
+#define CONCHECK_BUFFER_TEXT(x) CONCHECK_RECORD (x, buffer_text)
+#endif /* NEW_GC */
+
struct buffer
{
1.48 +64 -4 XEmacs/xemacs/src/bytecode.c
Index: bytecode.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/bytecode.c,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -p -r1.47 -r1.48
--- bytecode.c 2005/04/08 23:11:19 1.47
+++ bytecode.c 2005/11/25 01:41:56 1.48
＠＠ -58,6 +58,45 ＠＠ by Hallvard:
#include "syntax.h"
#include "window.h"
+#ifdef NEW_GC
+static Lisp_Object
+make_compiled_function_args (int totalargs)
+{
+ Lisp_Compiled_Function_Args *args;
+ args = (Lisp_Compiled_Function_Args *)
+ alloc_lrecord
+ (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args,
+ Lisp_Object, args, totalargs),
+ &lrecord_compiled_function_args);
+ args->size = totalargs;
+ return wrap_compiled_function_args (args);
+}
+
+static Bytecount
+size_compiled_function_args (const void *lheader)
+{
+ return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args,
+ Lisp_Object, args,
+ ((Lisp_Compiled_Function_Args *)
+ lheader)->size);
+}
+
+static const struct memory_description compiled_function_args_description[] = {
+ { XD_LONG, offsetof (Lisp_Compiled_Function_Args, size) },
+ { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Compiled_Function_Args, args),
+ XD_INDIRECT(0, 0) },
+ { XD_END }
+};
+
+DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("compiled-function-args",
+ compiled_function_args,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ compiled_function_args_description,
+ size_compiled_function_args,
+ Lisp_Compiled_Function_Args);
+#endif /* NEW_GC */
+
EXFUN (Ffetch_bytecode, 1);
Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code;
＠＠ -2022,13 +2061,21 ＠＠ optimize_compiled_function (Lisp_Object
}
if (totalargs)
+#ifdef NEW_GC
+ f->arguments = make_compiled_function_args (totalargs);
+#else /* not NEW_GC */
f->args = xnew_array (Lisp_Object, totalargs);
+#endif /* not NEW_GC */
{
LIST_LOOP_2 (arg, f->arglist)
{
if (!EQ (arg, Qand_optional) && !EQ (arg, Qand_rest))
+#ifdef NEW_GC
+ XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i++] = arg;
+#else /* not NEW_GC */
f->args[i++] = arg;
+#endif /* not NEW_GC */
}
}
＠＠ -2061,6 +2108,7 ＠＠ optimize_compiled_function (Lisp_Object
/************************************************************************/
/* The compiled-function object type */
/************************************************************************/
+
static void
print_compiled_function (Lisp_Object obj, Lisp_Object printcharfun,
int escapeflag)
＠＠ -2143,7 +2191,11 ＠＠ mark_compiled_function (Lisp_Object obj)
mark_object (f->annotated);
#endif
for (i = 0; i < f->args_in_array; i++)
+#ifdef NEW_GC
+ mark_object (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i]);
+#else /* not NEW_GC */
mark_object (f->args[i]);
+#endif /* not NEW_GC */
/* tail-recurse on constants */
return f->constants;
＠＠ -2179,8 +2231,12 ＠＠ compiled_function_hash (Lisp_Object obj,
static const struct memory_description compiled_function_description[] = {
{ XD_INT, offsetof (Lisp_Compiled_Function, args_in_array) },
- { XD_BLOCK_PTR, offsetof (Lisp_Compiled_Function, args),
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arguments) },
+#else /* not NEW_GC */
+ { XD_BLOCK_PTR, offsetof (Lisp_Compiled_Function, args),
XD_INDIRECT (0, 0), { &lisp_object_description } },
+#endif /* not NEW_GC */
{ XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, instructions) },
{ XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, constants) },
{ XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arglist) },
＠＠ -2191,7 +2247,7 ＠＠ static const struct memory_description c
{ XD_END }
};
-#ifdef MC_ALLOC
+#if defined(MC_ALLOC) && !defined(NEW_GC)
static void
finalize_compiled_function (void *header, int for_disksave)
{
＠＠ -2213,7 +2269,7 ＠＠ DEFINE_BASIC_LRECORD_IMPLEMENTATION ("co
compiled_function_hash,
compiled_function_description,
Lisp_Compiled_Function);
-#else /* not MC_ALLOC */
+#else /* !MC_ALLOC || NEW_GC */
DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function,
1, /*dumpable_flag*/
mark_compiled_function,
＠＠ -2222,7 +2278,8 ＠＠ DEFINE_BASIC_LRECORD_IMPLEMENTATION ("co
compiled_function_hash,
compiled_function_description,
Lisp_Compiled_Function);
-#endif /* not MC_ALLOC */
+#endif /* !MC_ALLOC || NEW_GC */
+
DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /*
Return t if OBJECT is a byte-compiled function object.
＠＠ -2594,6 +2651,9 ＠＠ void
syms_of_bytecode (void)
{
INIT_LRECORD_IMPLEMENTATION (compiled_function);
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (compiled_function_args);
+#endif /* NEW_GC */
DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state);
DEFSYMBOL (Qbyte_code);
1.9 +30 -0 XEmacs/xemacs/src/bytecode.h
Index: bytecode.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/bytecode.h,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -p -r1.8 -r1.9
--- bytecode.h 2002/04/14 12:42:14 1.8
+++ bytecode.h 2005/11/25 01:41:56 1.9
＠＠ -31,6 +31,32 ＠＠ Boston, MA 02111-1307, USA. */
#ifndef INCLUDED_bytecode_h_
#define INCLUDED_bytecode_h_
+#ifdef NEW_GC
+struct compiled_function_args
+{
+ struct lrecord_header header;
+ long size;
+ Lisp_Object args[1];
+};
+
+typedef struct compiled_function_args Lisp_Compiled_Function_Args;
+
+DECLARE_LRECORD (compiled_function_args, Lisp_Compiled_Function_Args);
+
+#define XCOMPILED_FUNCTION_ARGS(x) \
+ XRECORD (x, compiled_function_args, Lisp_Compiled_Function_Args)
+#define wrap_compiled_function_args(p) wrap_record (p, compiled_function_args)
+#define COMPILED_FUNCTION_ARGS_P(x) RECORDP (x, compiled_function_args)
+#define CHECK_COMPILED_FUNCTION_ARGS(x) \
+ CHECK_RECORD (x, compiled_function_args)
+#define CONCHECK_COMPILED_FUNCTION_ARGS(x) \
+ CONCHECK_RECORD (x, compiled_function_args)
+
+#define compiled_function_args_data(v) ((v)->args)
+#define XCOMPILED_FUNCTION_ARGS_DATA(s) \
+ compiled_function_args_data (XCOMPILED_FUNCTION_ARGS (s))
+#endif /* not NEW_GC */
+
/* Meanings of slots in a Lisp_Compiled_Function.
Don't use these! For backward compatibility only. */
#define COMPILED_ARGLIST 0
＠＠ -64,7 +90,11 ＠＠ struct Lisp_Compiled_Function
Lisp_Object arglist;
/* For speed, we unroll arglist into an array of argument symbols, so we
don't have to process arglist every time we make a function call. */
+#ifdef NEW_GC
+ Lisp_Object arguments;
+#else /* not NEW_GC */
Lisp_Object *args;
+#endif /* not NEW_GC */
/* Minimum and maximum number of arguments. If MAX_ARGS == MANY, the
function was declared with &rest, and (args_in_array - 1) indicates
how many arguments there are before the &rest argument. (We could
1.103 +17 -0 XEmacs/xemacs/src/config.h.in
Index: config.h.in
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/config.h.in,v
retrieving revision 1.102
retrieving revision 1.103
diff -u -p -r1.102 -r1.103
--- config.h.in 2005/10/25 11:19:58 1.102
+++ config.h.in 2005/11/25 01:41:56 1.103
＠＠ -414,6 +414,14 ＠＠ things are arranged in config.h.in. In
#undef HAVE_WCSCMP
#undef HAVE_WCSLEN
+/* Functions and structs checked for vdb. */
+#undef HAVE_MPROTECT
+#undef HAVE_SIGACTION
+#undef HAVE_STRUCT_SIGINFO_SI_ADDR
+#undef HAVE_SIGINFO_T_SI_ADDR
+#undef HAVE_SIGNAL
+#undef HAVE_STRUCT_SIGCONTEXT_CR2
+
#undef HAVE_UTIME
#undef HAVE_UTIMES
#undef HAVE_SIGSETJMP
＠＠ -680,6 +688,15 ＠＠ things are arranged in config.h.in. In
/* If defined, use experimental allocator. */
#undef MC_ALLOC
+
+/* If defined, use experimental incremental garbage collector. */
+#undef NEW_GC
+
+/* Virtual dirty bit implementation for incremental gc. */
+#undef VDB_POSIX
+#undef VDB_MACH
+#undef VDB_WIN32
+#undef VDB_FAKE
/* Enable special GNU Make features in the Makefiles. */
#undef USE_GNU_MAKE
1.6 +29 -0 XEmacs/xemacs/src/console-gtk-impl.h
Index: console-gtk-impl.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-gtk-impl.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -p -r1.5 -r1.6
--- console-gtk-impl.h 2004/07/07 12:01:06 1.5
+++ console-gtk-impl.h 2005/11/25 01:41:57 1.6
＠＠ -49,6 +49,9 ＠＠ DECLARE_CONSOLE_TYPE (gtk);
struct gtk_device
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
/* Gtk application info. */
GtkWidget *gtk_app_shell;
＠＠ -109,6 +112,17 ＠＠ struct gtk_device
#endif
};
+#ifdef NEW_GC
+typedef struct gtk_device Lisp_Gtk_Device;
+
+DECLARE_LRECORD (gtk_device, Lisp_Gtk_Device);
+
+#define XGTK_DEVICE(x) \
+ XRECORD (x, gtk_device, Lisp_Gtk_Device)
+#define wrap_gtk_device(p) wrap_record (p, gtk_device)
+#define GTK_DEVICE_P(x) RECORDP (x, gtk_device)
+#endif /* NEW_GC */
+
#define DEVICE_GTK_DATA(d) DEVICE_TYPE_DATA (d, gtk)
#define DEVICE_GTK_VISUAL(d) (DEVICE_GTK_DATA (d)->visual)
＠＠ -129,6 +143,10 ＠＠ struct gtk_device
struct gtk_frame
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
+
/* The widget of this frame. */
GtkWidget *widget; /* This is really a GtkWindow */
＠＠ -181,6 +199,17 ＠＠ struct gtk_frame
Lisp_Object widget_callback_hash_table;
Lisp_Object widget_callback_ex_hash_table;
};
+
+#ifdef NEW_GC
+typedef struct gtk_frame Lisp_Gtk_Frame;
+
+DECLARE_LRECORD (gtk_frame, Lisp_Gtk_Frame);
+
+#define XGTK_FRAME(x) \
+ XRECORD (x, gtk_frame, Lisp_Gtk_Frame)
+#define wrap_gtk_frame(p) wrap_record (p, gtk_frame)
+#define GTK_FRAME_P(x) RECORDP (x, gtk_frame)
+#endif /* NEW_GC */
#define FRAME_GTK_DATA(f) FRAME_TYPE_DATA (f, gtk)
1.6 +43 -0 XEmacs/xemacs/src/console-msw-impl.h
Index: console-msw-impl.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-msw-impl.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -p -r1.5 -r1.6
--- console-msw-impl.h 2005/10/24 10:07:34 1.5
+++ console-msw-impl.h 2005/11/25 01:41:57 1.6
＠＠ -81,6 +81,9 ＠＠ struct Lisp_Devmode
struct mswindows_device
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
Lisp_Object fontlist; /* List of (STRING . FIXED-P), device fonts */
HDC hcdc; /* Compatible DC */
DWORD update_tick; /* Used when device is modified through
＠＠ -88,6 +91,17 ＠＠ struct mswindows_device
in event-msw.c */
};
+#ifdef NEW_GC
+typedef struct mswindows_device Lisp_Mswindows_Device;
+
+DECLARE_LRECORD (mswindows_device, Lisp_Mswindows_Device);
+
+#define XMSWINDOWS_DEVICE(x) \
+ XRECORD (x, mswindows_device, Lisp_Mswindows_Device)
+#define wrap_mswindows_device(p) wrap_record (p, mswindows_device)
+#define MSWINDOWS_DEVICE_P(x) RECORDP (x, mswindows_device)
+#endif /* NEW_GC */
+
#define DEVICE_MSWINDOWS_DATA(d) DEVICE_TYPE_DATA (d, mswindows)
#define DEVICE_MSWINDOWS_FONTLIST(d) (DEVICE_MSWINDOWS_DATA (d)->fontlist)
#define DEVICE_MSWINDOWS_HCDC(d) (DEVICE_MSWINDOWS_DATA (d)->hcdc)
＠＠ -95,6 +109,9 ＠＠ struct mswindows_device
struct msprinter_device
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
HDC hdc, hcdc; /* Printer and the comp. DCs */
HANDLE hprinter;
Lisp_Object name;
＠＠ -102,6 +119,17 ＠＠ struct msprinter_device
Lisp_Object fontlist;
};
+#ifdef NEW_GC
+typedef struct msprinter_device Lisp_Msprinter_Device;
+
+DECLARE_LRECORD (msprinter_device, Lisp_Msprinter_Device);
+
+#define XMSPRINTER_DEVICE(x) \
+ XRECORD (x, msprinter_device, Lisp_Msprinter_Device)
+#define wrap_msprinter_device(p) wrap_record (p, msprinter_device)
+#define MSPRINTER_DEVICE_P(x) RECORDP (x, msprinter_device)
+#endif /* NEW_GC */
+
#define DEVICE_MSPRINTER_DATA(d) DEVICE_TYPE_DATA (d, msprinter)
#define DEVICE_MSPRINTER_HDC(d) (DEVICE_MSPRINTER_DATA (d)->hdc)
#define DEVICE_MSPRINTER_HCDC(d) (DEVICE_MSPRINTER_DATA (d)->hcdc)
＠＠ -139,6 +167,10 ＠＠ struct msprinter_device
struct mswindows_frame
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
+
/* win32 window handle */
HWND hwnd;
＠＠ -198,6 +230,17 ＠＠ struct mswindows_frame
creation. Members are set to -1 for unspecified */
XEMACS_RECT_WH *target_rect;
};
+
+#ifdef NEW_GC
+typedef struct mswindows_frame Lisp_Mswindows_Frame;
+
+DECLARE_LRECORD (mswindows_frame, Lisp_Mswindows_Frame);
+
+#define XMSWINDOWS_FRAME(x) \
+ XRECORD (x, mswindows_frame, Lisp_Mswindows_Frame)
+#define wrap_mswindows_frame(p) wrap_record (p, mswindows_frame)
+#define MSWINDOWS_FRAME_P(x) RECORDP (x, mswindows_frame)
+#endif /* NEW_GC */
#define FRAME_MSWINDOWS_DATA(f) FRAME_TYPE_DATA (f, mswindows)
1.3 +14 -0 XEmacs/xemacs/src/console-stream-impl.h
Index: console-stream-impl.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-stream-impl.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -p -r1.2 -r1.3
--- console-stream-impl.h 2003/01/12 11:08:09 1.2
+++ console-stream-impl.h 2005/11/25 01:41:57 1.3
＠＠ -34,12 +34,26 ＠＠ DECLARE_CONSOLE_TYPE (stream);
struct stream_console
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
FILE *in;
FILE *out;
FILE *err;
int needs_newline;
Lisp_Object instream;
};
+
+#ifdef NEW_GC
+typedef struct stream_console Lisp_Stream_Console;
+
+DECLARE_LRECORD (stream_console, Lisp_Stream_Console);
+
+#define XSTREAM_CONSOLE(x) \
+ XRECORD (x, stream_console, Lisp_Stream_Console)
+#define wrap_stream_console(p) wrap_record (p, stream_console)
+#define STREAM_CONSOLE_P(x) RECORDP (x, stream_console)
+#endif /* NEW_GC */
#define CONSOLE_STREAM_DATA(con) CONSOLE_TYPE_DATA (con, stream)
1.26 +18 -0 XEmacs/xemacs/src/console-stream.c
Index: console-stream.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-stream.c,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -p -r1.25 -r1.26
--- console-stream.c 2005/01/24 23:33:48 1.25
+++ console-stream.c 2005/11/25 01:41:57 1.26
＠＠ -53,9 +53,17 ＠＠ static const struct memory_description s
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("stream-console", stream_console,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ stream_console_data_description_1,
+ Lisp_Stream_Console);
+#else /* not NEW_GC */
const struct sized_memory_description stream_console_data_description = {
sizeof (struct stream_console), stream_console_data_description_1
};
+#endif /* not NEW_GC */
static void
stream_init_console (struct console *con, Lisp_Object UNUSED (params))
＠＠ -63,8 +71,14 ＠＠ stream_init_console (struct console *con
Lisp_Object tty = CONSOLE_CONNECTION (con);
struct stream_console *stream_con;
+#ifdef NEW_GC
if (CONSOLE_STREAM_DATA (con) == NULL)
+ CONSOLE_STREAM_DATA (con) = alloc_lrecord_type (struct stream_console,
+ &lrecord_stream_console);
+#else /* not NEW_GC */
+ if (CONSOLE_STREAM_DATA (con) == NULL)
CONSOLE_STREAM_DATA (con) = xnew_and_zero (struct stream_console);
+#endif /* not NEW_GC */
stream_con = CONSOLE_STREAM_DATA (con);
＠＠ -123,7 +137,11 ＠＠ stream_delete_console (struct console *c
if (stream_con->in != stdin)
retry_fclose (stream_con->in);
+#ifdef NEW_GC
+ mc_free (stream_con);
+#else /* not NEW_GC */
xfree (stream_con, struct stream_console *);
+#endif /* not NEW_GC */
CONSOLE_STREAM_DATA (con) = NULL;
}
}
1.8 +2 -0 XEmacs/xemacs/src/console-stream.h
Index: console-stream.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-stream.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -p -r1.7 -r1.8
--- console-stream.h 2003/01/12 11:08:09 1.7
+++ console-stream.h 2005/11/25 01:41:57 1.8
＠＠ -29,7 +29,9 ＠＠ Boston, MA 02111-1307, USA. */
#include "console.h"
+#ifndef NEW_GC
extern const struct sized_memory_description stream_console_data_description;
+#endif /* not NEW_GC */
extern Lisp_Object Vterminal_console, Vterminal_frame, Vterminal_device;
1.2 +28 -0 XEmacs/xemacs/src/console-tty-impl.h
Index: console-tty-impl.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-tty-impl.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- console-tty-impl.h 2002/06/20 21:18:24 1.1
+++ console-tty-impl.h 2005/11/25 01:41:57 1.2
＠＠ -39,6 +39,9 ＠＠ DECLARE_CONSOLE_TYPE (tty);
struct tty_console
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
int infd, outfd;
Lisp_Object instream, outstream;
Lisp_Object terminal_type;
＠＠ -199,6 +202,17 ＠＠ struct tty_console
unsigned int is_stdio :1;
};
+#ifdef NEW_GC
+typedef struct tty_console Lisp_Tty_Console;
+
+DECLARE_LRECORD (tty_console, Lisp_Tty_Console);
+
+#define XTTY_CONSOLE(x) \
+ XRECORD (x, tty_console, Lisp_Tty_Console)
+#define wrap_tty_console(p) wrap_record (p, tty_console)
+#define TTY_CONSOLE_P(x) RECORDP (x, tty_console)
+#endif /* NEW_GC */
+
#define CONSOLE_TTY_DATA(c) CONSOLE_TYPE_DATA (c, tty)
#define CONSOLE_TTY_CURSOR_X(c) (CONSOLE_TTY_DATA (c)->cursor_x)
#define CONSOLE_TTY_CURSOR_Y(c) (CONSOLE_TTY_DATA (c)->cursor_y)
＠＠ -228,12 +242,26 ＠＠ struct tty_console
struct tty_device
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
#ifdef HAVE_TERMIOS
speed_t ospeed; /* Output speed (from sg_ospeed) */
#else
short ospeed; /* Output speed (from sg_ospeed) */
#endif
};
+
+#ifdef NEW_GC
+typedef struct tty_device Lisp_Tty_Device;
+
+DECLARE_LRECORD (tty_device, Lisp_Tty_Device);
+
+#define XTTY_DEVICE(x) \
+ XRECORD (x, tty_device, Lisp_Tty_Device)
+#define wrap_tty_device(p) wrap_record (p, tty_device)
+#define TTY_DEVICE_P(x) RECORDP (x, tty_device)
+#endif /* NEW_GC */
#define DEVICE_TTY_DATA(d) DEVICE_TYPE_DATA (d, tty)
1.34 +17 -0 XEmacs/xemacs/src/console-tty.c
Index: console-tty.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-tty.c,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -p -r1.33 -r1.34
--- console-tty.c 2005/07/08 08:27:34 1.33
+++ console-tty.c 2005/11/25 01:41:58 1.34
＠＠ -59,16 +59,29 ＠＠ static const struct memory_description t
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("tty-console", tty_console,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ tty_console_data_description_1,
+ Lisp_Tty_Console);
+#else /* not NEW_GC */
const struct sized_memory_description tty_console_data_description = {
sizeof (struct tty_console), tty_console_data_description_1
};
+#endif /* not NEW_GC */
static void
allocate_tty_console_struct (struct console *con)
{
/* zero out all slots except the lisp ones ... */
+#ifdef NEW_GC
+ CONSOLE_TTY_DATA (con) = alloc_lrecord_type (struct tty_console,
+ &lrecord_tty_console);
+#else /* not NEW_GC */
CONSOLE_TTY_DATA (con) = xnew_and_zero (struct tty_console);
+#endif /* not NEW_GC */
CONSOLE_TTY_DATA (con)->terminal_type = Qnil;
CONSOLE_TTY_DATA (con)->instream = Qnil;
CONSOLE_TTY_DATA (con)->outstream = Qnil;
＠＠ -202,7 +215,11 ＠＠ free_tty_console_struct (struct console
xfree (tty_con->term_entry_buffer, char *);
tty_con->term_entry_buffer = NULL;
}
+#ifdef NEW_GC
+ mc_free (tty_con);
+#else /* not NEW_GC */
xfree (tty_con, struct tty_console *);
+#endif /* not NEW_GC */
CONSOLE_TTY_DATA (con) = NULL;
}
}
1.4 +28 -0 XEmacs/xemacs/src/console-x-impl.h
Index: console-x-impl.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-x-impl.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- console-x-impl.h 2004/11/04 23:06:18 1.3
+++ console-x-impl.h 2005/11/25 01:41:58 1.4
＠＠ -42,6 +42,9 ＠＠ DECLARE_CONSOLE_TYPE (x);
struct x_device
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
/* The X connection of this device. */
Display *display;
＠＠ -159,6 +162,17 ＠＠ struct x_device
Time modifier_release_time;
};
+#ifdef NEW_GC
+typedef struct x_device Lisp_X_Device;
+
+DECLARE_LRECORD (x_device, Lisp_X_Device);
+
+#define XX_DEVICE(x) \
+ XRECORD (x, x_device, Lisp_X_Device)
+#define wrap_x_device(p) wrap_record (p, x_device)
+#define X_DEVICE_P(x) RECORDP (x, x_device)
+#endif /* NEW_GC */
+
#define DEVICE_X_DATA(d) DEVICE_TYPE_DATA (d, x)
#define FRAME_X_DISPLAY(f) (DEVICE_X_DISPLAY (XDEVICE (f->device)))
＠＠ -225,6 +239,10 ＠＠ struct x_device
struct x_frame
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
+
/* The widget of this frame. This is an EmacsShell or an
ExternalShell. */
Widget widget;
＠＠ -311,6 +329,16 ＠＠ struct x_frame
#endif /* EXTERNAL_WIDGET */
};
+#ifdef NEW_GC
+typedef struct x_frame Lisp_X_Frame;
+
+DECLARE_LRECORD (x_frame, Lisp_X_Frame);
+
+#define XX_FRAME(x) \
+ XRECORD (x, x_frame, Lisp_X_Frame)
+#define wrap_x_frame(p) wrap_record (p, x_frame)
+#define X_FRAME_P(x) RECORDP (x, x_frame)
+#endif /* NEW_GC */
#define FRAME_X_DATA(f) FRAME_TYPE_DATA (f, x)
#define FRAME_X_SHELL_WIDGET(f) (FRAME_X_DATA (f)->widget)
1.45 +14 -0 XEmacs/xemacs/src/console.c
Index: console.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console.c,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -p -r1.44 -r1.45
--- console.c 2005/10/25 11:16:21 1.44
+++ console.c 2005/11/25 01:41:58 1.45
＠＠ -115,9 +115,17 ＠＠ console_type_entry_dynarr *the_console_t
static const struct memory_description console_data_description_1 []= {
#ifdef HAVE_TTY
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, tty_console },
+#else /* not NEW_GC */
{ XD_BLOCK_PTR, tty_console, 1, { &tty_console_data_description} },
+#endif /* not NEW_GC */
#endif
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, stream_console },
+#else /* not NEW_GC */
{ XD_BLOCK_PTR, stream_console, 1, { &stream_console_data_description} },
+#endif /* not NEW_GC */
{ XD_END }
};
＠＠ -1189,6 +1197,12 ＠＠ void
syms_of_console (void)
{
INIT_LRECORD_IMPLEMENTATION (console);
+#ifdef NEW_GC
+#ifdef HAVE_TTY
+ INIT_LRECORD_IMPLEMENTATION (tty_console);
+#endif
+ INIT_LRECORD_IMPLEMENTATION (stream_console);
+#endif /* not NEW_GC */
DEFSUBR (Fvalid_console_type_p);
DEFSUBR (Fconsole_type_list);
1.59 +8 -2 XEmacs/xemacs/src/depend
Index: depend
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/depend,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -p -r1.58 -r1.59
--- depend 2005/10/04 21:51:35 1.58
+++ depend 2005/11/25 01:41:58 1.59
＠＠ -11,7 +11,7 ＠＠ CONFIG_H=
LISP_H=
#else
CONFIG_H=config.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)
+LISP_H=lisp.h compiler.h config.h dumper.h gc.h general-slots.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h $(LISP_UNION_H)
#endif
#if defined(HAVE_MS_WINDOWS)
＠＠ -152,6 +152,7 ＠＠ fns.o: $(LISP_H) buffer.h bufslots.h byt
font-lock.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h insdel.h syntax.h
frame.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 events.h extents.h faces.h frame-impl.h frame.h frameslots.h glyphs.h gui.h gutter.h menubar.h process.h redisplay.h scrollbar.h specifier.h systime.h toolbar.h window-impl.h window.h winslots.h
free-hook.o: $(LISP_H) hash.h
+gc.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-impl.h console-stream.h console.h device.h elhash.h events.h extents-impl.h extents.h file-coding.h frame-impl.h frame.h frameslots.h glyphs.h lstream.h opaque.h process.h profile.h redisplay.h scrollbar.h specifier.h sysdep.h sysfile.h systime.h window-impl.h window.h winslots.h
general.o: $(LISP_H) general-slots.h
getloadavg.o: $(LISP_H) sysfile.h syssignal.h
gif_io.o: $(LISP_H) gifrlib.h sysfile.h
＠＠ -187,7 +188,7 ＠＠ lstream.o: $(LISP_H) buffer.h bufslots.h
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)
+mc-alloc.o: $(LISP_H) blocktype.h getpagesize.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
＠＠ -261,6 +262,11 ＠＠ unexsol2-6.o: compiler.h
unexsol2.o: compiler.h
unexsunos4.o: $(CONFIG_H) compiler.h
unicode.o: $(LISP_H) charset.h coding-system-slots.h file-coding.h opaque.h sysfile.h
+vdb-fake.o: $(LISP_H)
+vdb-mach.o: $(LISP_H)
+vdb-posix.o: $(LISP_H)
+vdb-win32.o: $(LISP_H) intl-auto-encap-win32.h syswindows.h
+vdb.o: $(LISP_H)
vm-limit.o: $(LISP_H) mem-limits.h
widget.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h
win32.o: $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h console-msw.h console.h hash.h intl-auto-encap-win32.h profile.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h
1.16 +20 -0 XEmacs/xemacs/src/device-gtk.c
Index: device-gtk.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/device-gtk.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -p -r1.15 -r1.16
--- device-gtk.c 2005/06/26 18:05:03 1.15
+++ device-gtk.c 2005/11/25 01:41:58 1.16
＠＠ -75,11 +75,19 ＠＠ static const struct memory_description g
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("gtk-device", gtk_device,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ gtk_device_data_description_1,
+ Lisp_Gtk_Device);
+#else /* not NEW_GC */
extern const struct sized_memory_description gtk_device_data_description;
const struct sized_memory_description gtk_device_data_description = {
sizeof (struct gtk_device), gtk_device_data_description_1
};
+#endif /* not NEW_GC */
/************************************************************************/
＠＠ -108,7 +116,11 ＠＠ extern Lisp_Object __get_gtk_font_truena
static void
allocate_gtk_device_struct (struct device *d)
{
+#ifdef NEW_GC
+ d->device_data = alloc_lrecord_type (struct gtk_device, &lrecord_gtk_device);
+#else /* not NEW_GC */
d->device_data = xnew_and_zero (struct gtk_device);
+#endif /* not NEW_GC */
DEVICE_GTK_DATA (d)->x_keysym_map_hashtable = Qnil;
}
＠＠ -350,7 +362,11 ＠＠ gtk_mark_device (struct device *d)
static void
free_gtk_device_struct (struct device *d)
{
+#ifdef NEW_GC
+ mc_free (d->device_data);
+#else /* not NEW_GC */
xfree (d->device_data, void *);
+#endif /* not NEW_GC */
}
static void
＠＠ -681,6 +697,10 ＠＠ Get the style information for a Gtk devi
void
syms_of_device_gtk (void)
{
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (gtk_device);
+#endif /* NEW_GC */
+
DEFSUBR (Fgtk_keysym_on_keyboard_p);
DEFSUBR (Fgtk_display_visual_class);
DEFSUBR (Fgtk_display_visual_depth);
1.60 +39 -0 XEmacs/xemacs/src/device-msw.c
Index: device-msw.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/device-msw.c,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -p -r1.59 -r1.60
--- device-msw.c 2005/10/25 11:16:22 1.59
+++ device-msw.c 2005/11/25 01:41:58 1.60
＠＠ -73,11 +73,19 ＠＠ static const struct memory_description m
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("mswindows-device", mswindows_device,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ mswindows_device_data_description_1,
+ Lisp_Mswindows_Device);
+#else /* not NEW_GC */
extern const struct sized_memory_description mswindows_device_data_description;
const struct sized_memory_description mswindows_device_data_description = {
sizeof (struct mswindows_device), mswindows_device_data_description_1
};
+#endif /* not NEW_GC */
static const struct memory_description msprinter_device_data_description_1 [] = {
{ XD_LISP_OBJECT, offsetof (struct msprinter_device, name) },
＠＠ -86,11 +94,19 ＠＠ static const struct memory_description m
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("msprinter-device", msprinter_device,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ msprinter_device_data_description_1,
+ Lisp_Msprinter_Device);
+#else /* not NEW_GC */
extern const struct sized_memory_description msprinter_device_data_description;
const struct sized_memory_description msprinter_device_data_description = {
sizeof (struct msprinter_device), msprinter_device_data_description_1
};
+#endif /* not NEW_GC */
static Lisp_Object allocate_devmode (DEVMODEW *src_devmode, int do_copy,
Lisp_Object src_name, struct device *d);
＠＠ -146,7 +162,12 ＠＠ mswindows_init_device (struct device *d,
init_baud_rate (d);
init_one_device (d);
+#ifdef NEW_GC
+ d->device_data = alloc_lrecord_type (struct mswindows_device,
+ &lrecord_mswindows_device);
+#else /* not NEW_GC */
d->device_data = xnew_and_zero (struct mswindows_device);
+#endif /* not NEW_GC */
hdc = CreateCompatibleDC (NULL);
assert (hdc != NULL);
DEVICE_MSWINDOWS_HCDC (d) = hdc;
＠＠ -279,7 +300,11 ＠＠ mswindows_delete_device (struct device *
#endif
DeleteDC (DEVICE_MSWINDOWS_HCDC (d));
+#ifdef NEW_GC
+ mc_free (d->device_data);
+#else /* not NEW_GC */
xfree (d->device_data, void *);
+#endif /* not NEW_GC */
}
void
＠＠ -495,7 +520,12 ＠＠ msprinter_init_device (struct device *d,
LONG dm_size;
Extbyte *printer_name;
+#ifdef NEW_GC
+ d->device_data = alloc_lrecord_type (struct msprinter_device,
+ &lrecord_msprinter_device);
+#else /* not NEW_GC */
d->device_data = xnew_and_zero (struct msprinter_device);
+#endif /* not NEW_GC */
DEVICE_INFD (d) = DEVICE_OUTFD (d) = -1;
DEVICE_MSPRINTER_DEVMODE (d) = Qnil;
＠＠ -546,7 +576,11 ＠＠ msprinter_delete_device (struct device *
DEVICE_MSPRINTER_DEVMODE (d) = Qnil;
}
+#ifdef NEW_GC
+ mc_free (d->device_data);
+#else /* not NEW_GC */
xfree (d->device_data, void *);
+#endif /* not NEW_GC */
}
}
＠＠ -1344,6 +1378,11 ＠＠ void
syms_of_device_mswindows (void)
{
INIT_LRECORD_IMPLEMENTATION (devmode);
+
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (mswindows_device);
+ INIT_LRECORD_IMPLEMENTATION (msprinter_device);
+#endif /* NEW_GC */
DEFSUBR (Fmsprinter_get_settings);
DEFSUBR (Fmsprinter_select_settings);
1.19 +24 -0 XEmacs/xemacs/src/device-tty.c
Index: device-tty.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/device-tty.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -p -r1.18 -r1.19
--- device-tty.c 2005/01/24 23:33:49 1.18
+++ device-tty.c 2005/11/25 01:41:59 1.19
＠＠ -44,10 +44,26 ＠＠ Boston, MA 02111-1307, USA. */
Lisp_Object Qinit_pre_tty_win, Qinit_post_tty_win;
+#ifdef NEW_GC
+static const struct memory_description tty_device_data_description_1 [] = {
+ { XD_END }
+};
+
+DEFINE_LRECORD_IMPLEMENTATION ("tty-device", tty_device,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ tty_device_data_description_1,
+ Lisp_Tty_Device);
+#endif /* NEW_GC */
+
static void
allocate_tty_device_struct (struct device *d)
{
+#ifdef NEW_GC
+ d->device_data = alloc_lrecord_type (struct tty_device, &lrecord_tty_device);
+#else /* not NEW_GC */
d->device_data = xnew_and_zero (struct tty_device);
+#endif /* not NEW_GC */
}
static void
＠＠ -97,6 +113,7 ＠＠ tty_init_device (struct device *d, Lisp_
call0 (Qinit_pre_tty_win);
}
+#ifndef NEW_GC
static void
free_tty_device_struct (struct device *d)
{
＠＠ -109,6 +126,7 ＠＠ tty_delete_device (struct device *d)
{
free_tty_device_struct (d);
}
+#endif /* not NEW_GC */
#ifdef SIGWINCH
＠＠ -189,6 +207,10 ＠＠ tty_device_system_metrics (struct device
void
syms_of_device_tty (void)
{
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (tty_device);
+#endif /* NEW_GC */
+
DEFSYMBOL (Qinit_pre_tty_win);
DEFSYMBOL (Qinit_post_tty_win);
}
＠＠ -198,7 +220,9 ＠＠ console_type_create_device_tty (void)
{
/* device methods */
CONSOLE_HAS_METHOD (tty, init_device);
+#ifndef NEW_GC
CONSOLE_HAS_METHOD (tty, delete_device);
+#endif /* not NEW_GC */
#ifdef SIGWINCH
CONSOLE_HAS_METHOD (tty, asynch_device_change);
#endif /* SIGWINCH */
1.66 +20 -0 XEmacs/xemacs/src/device-x.c
Index: device-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/device-x.c,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -p -r1.65 -r1.66
--- device-x.c 2005/10/25 11:16:22 1.65
+++ device-x.c 2005/11/25 01:41:59 1.66
＠＠ -109,11 +109,19 ＠＠ static const struct memory_description x
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("x-device", x_device,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ x_device_data_description_1,
+ Lisp_X_Device);
+#else /* not NEW_GC */
extern const struct sized_memory_description x_device_data_description;
const struct sized_memory_description x_device_data_description = {
sizeof (struct x_device), x_device_data_description_1
};
+#endif /* not NEW_GC */
/* Functions to synchronize mirroring resources and specifiers */
int in_resource_setting;
＠＠ -202,7 +210,11 ＠＠ static struct device *device_being_initi
static void
allocate_x_device_struct (struct device *d)
{
+#ifdef NEW_GC
+ d->device_data = alloc_lrecord_type (struct x_device, &lrecord_x_device);
+#else /* not NEW_GC */
d->device_data = xnew_and_zero (struct x_device);
+#endif /* not NEW_GC */
}
static void
＠＠ -885,7 +897,11 ＠＠ x_mark_device (struct device *d)
static void
free_x_device_struct (struct device *d)
{
+#ifdef NEW_GC
+ mc_free (d->device_data);
+#else /* not NEW_GC */
xfree (d->device_data, void *);
+#endif /* not NEW_GC */
}
static void
＠＠ -2037,6 +2053,10 ＠＠ See also `x-get-font-path'.
void
syms_of_device_x (void)
{
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (x_device);
+#endif /* NEW_GC */
+
DEFSUBR (Fx_debug_mode);
DEFSUBR (Fx_get_resource);
DEFSUBR (Fx_get_resource_prefix);
1.37 +15 -0 XEmacs/xemacs/src/device.c
Index: device.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/device.c,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -p -r1.36 -r1.37
--- device.c 2005/10/25 11:16:22 1.36
+++ device.c 2005/11/25 01:41:59 1.37
＠＠ -86,13 +86,27 ＠＠ Lisp_Object Vdevice_class_list;
+#ifndef NEW_GC
extern const struct sized_memory_description gtk_device_data_description;
extern const struct sized_memory_description mswindows_device_data_description;
extern const struct sized_memory_description msprinter_device_data_description;
extern const struct sized_memory_description x_device_data_description;
+#endif /* not NEW_GC */
static const struct memory_description device_data_description_1 []= {
+#ifdef NEW_GC
#ifdef HAVE_GTK
+ { XD_LISP_OBJECT, gtk_console },
+#endif
+#ifdef HAVE_MS_WINDOWS
+ { XD_LISP_OBJECT, mswindows_console },
+ { XD_LISP_OBJECT, msprinter_console },
+#endif
+#ifdef HAVE_X_WINDOWS
+ { XD_LISP_OBJECT, x_console },
+#endif
+#else /* not NEW_GC */
+#ifdef HAVE_GTK
{ XD_BLOCK_PTR, gtk_console, 1, { >k_device_data_description} },
#endif
#ifdef HAVE_MS_WINDOWS
＠＠ -102,6 +116,7 ＠＠ static const struct memory_description d
#ifdef HAVE_X_WINDOWS
{ XD_BLOCK_PTR, x_console, 1, { &x_device_data_description} },
#endif
+#endif /* not NEW_GC */
{ XD_END }
};
1.32 +103 -13 XEmacs/xemacs/src/dumper.c
Index: dumper.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/dumper.c,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -p -r1.31 -r1.32
--- dumper.c 2005/10/14 01:22:00 1.31
+++ dumper.c 2005/11/25 01:41:59 1.32
＠＠ -686,6 +686,12 ＠＠ pdump_bump_depth (void)
}
static void pdump_register_object (Lisp_Object obj);
+#ifdef NEW_GC
+static void pdump_register_object_array (Lisp_Object data,
+ Bytecount size,
+ const struct memory_description *desc,
+ int count);
+#endif /* NEW_GC */
static void pdump_register_block_contents (const void *data,
Bytecount size,
const struct memory_description *
＠＠ -781,6 +787,20 ＠＠ pdump_register_sub (const void *data, co
}
break;
}
+#ifdef NEW_GC
+ case XD_LISP_OBJECT_BLOCK_PTR:
+ {
+ EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
+ data);
+ const struct sized_memory_description *sdesc =
+ lispdesc_indirect_description (data, desc1->data2.descr);
+ const Lisp_Object *pobj = (const Lisp_Object *) rdata;
+ if (pobj)
+ pdump_register_object_array
+ (*pobj, sdesc->size, sdesc->description, count);
+ break;
+ }
+#endif /* NEW_GC */
case XD_BLOCK_PTR:
{
EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
＠＠ -876,6 +896,47 ＠＠ pdump_register_object (Lisp_Object obj)
}
}
+#ifdef NEW_GC
+static void
+pdump_register_object_array (Lisp_Object obj,
+ Bytecount size,
+ const struct memory_description *desc,
+ int count)
+{
+ struct lrecord_header *objh;
+ const struct lrecord_implementation *imp;
+
+ if (!POINTER_TYPE_P (XTYPE (obj)))
+ return;
+
+ objh = XRECORD_LHEADER (obj);
+ if (!objh)
+ return;
+
+ if (pdump_get_block (objh))
+ return;
+
+ imp = LHEADER_IMPLEMENTATION (objh);
+
+ if (imp->description
+ && RECORD_DUMPABLE (objh))
+ {
+ pdump_bump_depth ();
+ backtrace[pdump_depth - 1].obj = objh;
+ pdump_add_block (pdump_object_table + objh->type,
+ objh, lispdesc_block_size_1 (objh, size, desc), count);
+ pdump_register_block_contents (objh, size, desc, count);
+ --pdump_depth;
+ }
+ else
+ {
+ pdump_alert_undump_object[objh->type]++;
+ stderr_out ("Undumpable object type : %s\n", imp->name);
+ pdump_backtrace ();
+ }
+}
+#endif /* NEW_GC */
+
/* Register the referenced objects in the array of COUNT blocks located at
DATA; each block is described by SIZE and DESC. "Block" here simply
means any block of memory.
＠＠ -994,6 +1055,9 ＠＠ pdump_store_new_pointer_offsets (int cou
* (int *) rdata = val;
break;
}
+#ifdef NEW_GC
+ case XD_LISP_OBJECT_BLOCK_PTR:
+#endif /* NEW_GC */
case XD_OPAQUE_DATA_PTR:
case XD_ASCII_STRING:
case XD_BLOCK_PTR:
＠＠ -1173,7 +1237,9 ＠＠ pdump_scan_lisp_objects_by_alignment (vo
if (pdump_object_table[i].align == align)
for (elt = pdump_object_table[i].first; elt; elt = elt->next)
{
+#ifndef NEW_GC
assert (elt->count == 1);
+#endif /* not NEW_GC */
f (elt, lrecord_implementations_table[i]->description);
}
}
＠＠ -1234,6 +1300,9 ＠＠ pdump_reloc_one_mc (void *data, const st
case XD_LONG:
case XD_INT_RESET:
break;
+#ifdef NEW_GC
+ case XD_LISP_OBJECT_BLOCK_PTR:
+#endif /* NEW_GC */
case XD_OPAQUE_DATA_PTR:
case XD_ASCII_STRING:
case XD_BLOCK_PTR:
＠＠ -1252,7 +1321,7 ＠＠ pdump_reloc_one_mc (void *data, const st
if (POINTER_TYPE_P (XTYPE (*pobj))
&& ! EQ (*pobj, Qnull_pointer))
- *pobj = wrap_pointer_1 ((char *) pdump_get_mc_addr
+ *pobj = wrap_pointer_1 ((Rawbyte *) pdump_get_mc_addr
(XPNTR (*pobj)));
break;
}
＠＠ -1268,7 +1337,7 ＠＠ pdump_reloc_one_mc (void *data, const st
if (POINTER_TYPE_P (XTYPE (*pobj))
&& ! EQ (*pobj, Qnull_pointer))
- *pobj = wrap_pointer_1 ((char *) pdump_get_mc_addr
+ *pobj = wrap_pointer_1 ((Rawbyte *) pdump_get_mc_addr
(XPNTR (*pobj)));
}
break;
＠＠ -1687,7 +1756,16 ＠＠ pdump_dump_rtables (void)
while (elt)
{
EMACS_INT rdata = pdump_get_block (elt->obj)->save_offset;
+#ifdef NEW_GC
+ int j;
+ for (j=0; j<elt->count; j++)
+ {
+ PDUMP_WRITE_ALIGNED (EMACS_INT, rdata);
+ rdata += elt->size;
+ }
+#else /* not NEW_GC */
PDUMP_WRITE_ALIGNED (EMACS_INT, rdata);
+#endif /* not NEW_GC */
elt = elt->next;
}
}
＠＠ -2136,6 +2214,14 ＠＠ pdump_load_finish (void)
EMACS_INT count;
pdump_header *header = (pdump_header *) pdump_start;
+#ifdef NEW_GC
+ /* This is a DEFVAR_BOOL and gets dumped, but the actual value was
+ already determined by vdb_install_signal_handler () in
+ vdb-mprotect.c, which could be different from the value in the
+ dump file. So store it here and restore it after loading the dump
+ file. */
+ int allow_inc_gc = allow_incremental_gc;
+#endif /* NEW_GC */
pdump_end = pdump_start + pdump_length;
delta = ((EMACS_INT) pdump_start) - header->reloc_address;
＠＠ -2163,16 +2249,16 ＠＠ pdump_load_finish (void)
Bytecount real_size = size * elt_count;
if (count == 2)
{
- mc_addr = (Rawbyte *) mc_alloc (real_size);
+ if (elt_count <= 1)
+ mc_addr = (Rawbyte *) mc_alloc (real_size);
+#ifdef NEW_GC
+ else
+ mc_addr = (Rawbyte *) mc_alloc_array (size, elt_count);
+#endif /* NEW_GC */
#ifdef ALLOC_TYPE_STATS
inc_lrecord_stats (real_size,
(const struct lrecord_header *)
- ((char *) rdata + delta));
- if (((const struct lrecord_header *)
- ((char *) rdata + delta))->type
- == lrecord_type_string)
- inc_lrecord_string_data_stats
- (((Lisp_String *) ((char *) rdata + delta))->size_);
+ ((Rawbyte *) rdata + delta));
#endif /* ALLOC_TYPE_STATS */
}
else
＠＠ -2182,7 +2268,7 ＠＠ pdump_load_finish (void)
mc_addr += size;
pdump_put_mc_addr ((void *) rdata, (EMACS_INT) mc_addr);
- memcpy (mc_addr, (char *) rdata + delta, size);
+ memcpy (mc_addr, (Rawbyte *) rdata + delta, size);
}
}
else if (!(--count))
＠＠ -2217,13 +2303,13 ＠＠ pdump_load_finish (void)
p = (Rawbyte *) ALIGN_PTR (p, Rawbyte *);
if (rt.desc)
{
- char **reloc = (char **) p;
+ Rawbyte **reloc = (Rawbyte **) p;
for (i = 0; i < rt.count; i++)
{
- reloc[i] = (char *) pdump_get_mc_addr (reloc[i]);
+ reloc[i] = (Rawbyte *) pdump_get_mc_addr (reloc[i]);
pdump_reloc_one_mc (reloc[i], rt.desc);
}
- p += rt.count * sizeof (char *);
+ p += rt.count * sizeof (Rawbyte *);
}
else if (!(--count))
break;
＠＠ -2319,6 +2405,10 ＠＠ pdump_load_finish (void)
#ifdef MC_ALLOC
xfree (pdump_mc_hash, mc_addr_elt *);
#endif /* MC_ALLOC */
+
+#ifdef NEW_GC
+ allow_incremental_gc = allow_inc_gc;
+#endif /* NEW_GC */
return 1;
}
1.13 +57 -0 XEmacs/xemacs/src/dynarr.c
Index: dynarr.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/dynarr.c,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -p -r1.12 -r1.13
--- dynarr.c 2005/01/24 23:33:50 1.12
+++ dynarr.c 2005/11/25 01:41:59 1.13
＠＠ -150,6 +150,39 ＠＠ Dynarr_newf (int elsize)
return d;
}
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("dynarr", dynarr,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ 0,
+ Dynarr);
+
+static void
+Dynarr_lisp_realloc (Dynarr *dy, Elemcount new_size)
+{
+ void *new_base = alloc_lrecord_array (dy->elsize, new_size, dy->lisp_imp);
+ void *old_base = dy->base;
+ if (dy->base)
+ memcpy (new_base, dy->base,
+ (dy->max > new_size ? dy->max : new_size) * dy->elsize);
+ dy->base = new_base;
+ if (old_base)
+ mc_free (old_base);
+}
+
+void *
+Dynarr_lisp_newf (int elsize,
+ const struct lrecord_implementation *dynarr_imp,
+ const struct lrecord_implementation *imp)
+{
+ Dynarr *d = (Dynarr *) alloc_lrecord (sizeof (Dynarr), dynarr_imp);
+ d->elsize = elsize;
+ d->lisp_imp = imp;
+
+ return d;
+}
+#endif /* not NEW_GC */
+
void
Dynarr_resize (void *d, Elemcount size)
{
＠＠ -168,7 +201,14 ＠＠ Dynarr_resize (void *d, Elemcount size)
/* Don't do anything if the array is already big enough. */
if (newsize > dy->max)
{
+#ifdef NEW_GC
+ if (dy->lisp_imp)
+ Dynarr_lisp_realloc (dy, newsize);
+ else
+ Dynarr_realloc (dy, newsize*dy->elsize);
+#else /* not NEW_GC */
Dynarr_realloc (dy, newsize*dy->elsize);
+#endif /* not NEW_GC */
dy->max = newsize;
}
}
＠＠ -222,10 +262,27 ＠＠ Dynarr_free (void *d)
{
Dynarr *dy = (Dynarr *) d;
+#ifdef NEW_GC
+ if (dy->base && !DUMPEDP (dy->base))
+ {
+ if (dy->lisp_imp)
+ mc_free (dy->base);
+ else
+ xfree (dy->base, void *);
+ }
+ if(!DUMPEDP (dy))
+ {
+ if (dy->lisp_imp)
+ mc_free (dy);
+ else
+ xfree (dy, Dynarr *);
+ }
+#else /* not NEW_GC */
if (dy->base && !DUMPEDP (dy->base))
xfree (dy->base, void *);
if(!DUMPEDP (dy))
xfree (dy, Dynarr *);
+#endif /* not NEW_GC */
}
#ifdef MEMORY_USAGE_STATS
1.44 +75 -1 XEmacs/xemacs/src/elhash.c
Index: elhash.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/elhash.c,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -p -r1.43 -r1.44
--- elhash.c 2005/10/24 10:07:35 1.43
+++ elhash.c 2005/11/25 01:42:00 1.44
＠＠ -96,6 +96,9 ＠＠ static Lisp_Object Qnon_weak, Q_type;
typedef struct htentry
{
+#ifdef NEW_GC
+ struct lrecord_header lheader;
+#endif /* NEW_GC */
Lisp_Object key;
Lisp_Object value;
} htentry;
＠＠ -406,7 +409,12 ＠＠ print_hash_table (Lisp_Object obj, Lisp_
}
static void
-free_hentries (htentry *hentries,
+free_hentries (
+#if defined (NEW_GC) && !defined (ERROR_CHECK_STRUCTURES)
+ htentry *UNUSED (hentries),
+#else
+ htentry *hentries,
+#endif
#ifdef ERROR_CHECK_STRUCTURES
size_t size
#else
＠＠ -414,6 +422,14 ＠＠ free_hentries (htentry *hentries,
#endif
)
{
+#ifdef NEW_GC
+#ifdef ERROR_CHECK_STRUCTURES
+ htentry *e, *sentinel;
+
+ for (e = hentries, sentinel = e + size; e < sentinel; e++)
+ mc_free (e);
+#endif
+#else /* not NEW_GC */
#ifdef ERROR_CHECK_STRUCTURES
/* Ensure a crash if other code uses the discarded entries afterwards. */
htentry *e, *sentinel;
＠＠ -424,6 +440,7 ＠＠ free_hentries (htentry *hentries,
if (!DUMPEDP (hentries))
xfree (hentries, htentry *);
+#endif /* not NEW_GC */
}
static void
＠＠ -448,13 +465,39 ＠＠ static const struct sized_memory_descrip
htentry_description_1
};
+#ifdef NEW_GC
+static const struct memory_description htentry_weak_description_1[] = {
+ { XD_LISP_OBJECT, offsetof (htentry, key), 0, { 0 }, XD_FLAG_NO_KKCC},
+ { XD_LISP_OBJECT, offsetof (htentry, value), 0, { 0 }, XD_FLAG_NO_KKCC},
+ { XD_END }
+};
+
+static const struct sized_memory_description htentry_weak_description = {
+ sizeof (htentry),
+ htentry_weak_description_1
+};
+
+DEFINE_LRECORD_IMPLEMENTATION ("hash-table-entry", hash_table_entry,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ htentry_description_1,
+ Lisp_Hash_Table_Entry);
+#endif /* NEW_GC */
+
static const struct memory_description htentry_union_description_1[] = {
/* Note: XD_INDIRECT in this table refers to the surrounding table,
and so this will work. */
+#ifdef NEW_GC
+ { XD_LISP_OBJECT_BLOCK_PTR, HASH_TABLE_NON_WEAK,
+ XD_INDIRECT (0, 1), { &htentry_description } },
+ { XD_LISP_OBJECT_BLOCK_PTR, 0, XD_INDIRECT (0, 1),
+ { &htentry_weak_description }, XD_FLAG_UNION_DEFAULT_ENTRY },
+#else /* not NEW_GC */
{ XD_BLOCK_PTR, HASH_TABLE_NON_WEAK, XD_INDIRECT (0, 1),
{ &htentry_description } },
{ XD_BLOCK_PTR, 0, XD_INDIRECT (0, 1), { &htentry_description },
XD_FLAG_UNION_DEFAULT_ENTRY | XD_FLAG_NO_KKCC },
+#endif /* not NEW_GC */
{ XD_END }
};
＠＠ -572,7 +615,13 ＠＠ make_general_lisp_hash_table (hash_table
compute_hash_table_derived_values (ht);
/* We leave room for one never-occupied sentinel htentry at the end. */
+#ifdef NEW_GC
+ ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry),
+ ht->size + 1,
+ &lrecord_hash_table_entry);
+#else /* not NEW_GC */
ht->hentries = xnew_array_and_zero (htentry, ht->size + 1);
+#endif /* not NEW_GC */
hash_table = wrap_hash_table (ht);
＠＠ -970,7 +1019,13 ＠＠ The keys and values will not themselves
Lisp_Hash_Table *ht = ALLOC_LCRECORD_TYPE (Lisp_Hash_Table, &lrecord_hash_table);
COPY_LCRECORD (ht, ht_old);
+#ifdef NEW_GC
+ ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry),
+ ht_old->size + 1,
+ &lrecord_hash_table_entry);
+#else /* not NEW_GC */
ht->hentries = xnew_array (htentry, ht_old->size + 1);
+#endif /* not NEW_GC */
memcpy (ht->hentries, ht_old->hentries, (ht_old->size + 1) * sizeof (htentry));
hash_table = wrap_hash_table (ht);
＠＠ -995,7 +1050,13 ＠＠ resize_hash_table (Lisp_Hash_Table *ht,
old_entries = ht->hentries;
+#ifdef NEW_GC
+ ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry),
+ new_size + 1,
+ &lrecord_hash_table_entry);
+#else /* not NEW_GC */
ht->hentries = xnew_array_and_zero (htentry, new_size + 1);
+#endif /* not NEW_GC */
new_entries = ht->hentries;
compute_hash_table_derived_values (ht);
＠＠ -1019,7 +1080,13 ＠＠ void
pdump_reorganize_hash_table (Lisp_Object hash_table)
{
const Lisp_Hash_Table *ht = xhash_table (hash_table);
+#ifdef NEW_GC
+ htentry *new_entries =
+ (htentry *) alloc_lrecord_array (sizeof (htentry), ht->size + 1,
+ &lrecord_hash_table_entry);
+#else /* not NEW_GC */
htentry *new_entries = xnew_array_and_zero (htentry, ht->size + 1);
+#endif /* not NEW_GC */
htentry *e, *sentinel;
for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++)
＠＠ -1033,7 +1100,11 ＠＠ pdump_reorganize_hash_table (Lisp_Object
memcpy (ht->hentries, new_entries, ht->size * sizeof (htentry));
+#ifdef NEW_GC
+ mc_free (new_entries);
+#else /* not NEW_GC */
xfree (new_entries, htentry *);
+#endif /* not NEW_GC */
}
static void
＠＠ -1761,6 +1832,9 ＠＠ void
init_elhash_once_early (void)
{
INIT_LRECORD_IMPLEMENTATION (hash_table);
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (hash_table_entry);
+#endif /* NEW_GC */
/* This must NOT be staticpro'd */
Vall_weak_hash_tables = Qnil;
1.16 +13 -0 XEmacs/xemacs/src/elhash.h
Index: elhash.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/elhash.h,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -p -r1.15 -r1.16
--- elhash.h 2005/01/26 10:22:25 1.15
+++ elhash.h 2005/11/25 01:42:00 1.16
＠＠ -33,6 +33,19 ＠＠ DECLARE_LRECORD (hash_table, Lisp_Hash_T
#define CHECK_HASH_TABLE(x) CHECK_RECORD (x, hash_table)
#define CONCHECK_HASH_TABLE(x) CONCHECK_RECORD (x, hash_table)
+#ifdef NEW_GC
+typedef struct htentry Lisp_Hash_Table_Entry;
+
+DECLARE_LRECORD (hash_table_entry, Lisp_Hash_Table_Entry);
+
+#define XHASH_TABLE_ENTRY(x) \
+ XRECORD (x, hash_table_entry, Lisp_Hash_Table_Entry)
+#define wrap_hash_table_entry(p) wrap_record (p, hash_table_entry)
+#define HASH_TABLE_ENTRYP(x) RECORDP (x, hash_table_entry)
+#define CHECK_HASH_TABLE_ENTRY(x) CHECK_RECORD (x, hash_table_entry)
+#define CONCHECK_HASH_TABLE_ENTRY(x) CONCHECK_RECORD (x, hash_table_entry)
+#endif /* NEW_GC */
+
enum hash_table_weakness
{
HASH_TABLE_NON_WEAK,
1.161 +43 -3 XEmacs/xemacs/src/emacs.c
Index: emacs.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/emacs.c,v
retrieving revision 1.160
retrieving revision 1.161
diff -u -p -r1.160 -r1.161
--- emacs.c 2005/10/25 08:32:47 1.160
+++ emacs.c 2005/11/25 01:42:00 1.161
＠＠ -1312,6 +1312,9 ＠＠ main_1 (int argc, Wexttext **argv, Wextt
the Lisp engine and need to be done both at dump time and at run time. */
init_signals_very_early ();
+#ifdef NEW_GC
+ vdb_install_signal_handler ();
+#endif
init_data_very_early (); /* Catch math errors. */
init_floatfns_very_early (); /* Catch floating-point math errors. */
init_process_times_very_early (); /* Initialize our process timers.
＠＠ -1397,6 +1400,8 ＠＠ main_1 (int argc, Wexttext **argv, Wextt
init_alloc_early ();
+ init_gc_early ();
+
if (!initialized)
{
/* Initialize things so that new Lisp objects
＠＠ -1406,6 +1411,8 ＠＠ main_1 (int argc, Wexttext **argv, Wextt
routines below create new objects. */
init_alloc_once_early ();
+ init_gc_once_early ();
+
/* Initialize Qnil, Qt, Qunbound, and the
obarray. After this, symbols can be
interned. This depends on init_alloc_once_early(). */
＠＠ -1444,6 +1451,10 ＠＠ main_1 (int argc, Wexttext **argv, Wextt
#ifdef MC_ALLOC
syms_of_mc_alloc ();
#endif /* MC_ALLOC */
+ syms_of_gc ();
+#ifdef NEW_GC
+ syms_of_vdb ();
+#endif /* NEW_GC */
syms_of_buffer ();
syms_of_bytecode ();
syms_of_callint ();
＠＠ -1850,6 +1861,7 ＠＠ main_1 (int argc, Wexttext **argv, Wextt
(note, we are inside ifdef PDUMP) */
{
reinit_alloc_early ();
+ reinit_gc_early ();
reinit_symbols_early ();
#ifndef MC_ALLOC
reinit_opaque_early ();
＠＠ -2054,6 +2066,7 ＠＠ main_1 (int argc, Wexttext **argv, Wextt
vars_of_font_lock ();
#endif /* USE_C_FONT_LOCK */
vars_of_frame ();
+ vars_of_gc ();
vars_of_glyphs ();
vars_of_glyphs_eimage ();
vars_of_glyphs_widget ();
＠＠ -2394,9 +2407,6 ＠＠ main_1 (int argc, Wexttext **argv, Wextt
#endif
/* This calls Fmake_glyph_internal(). */
- complex_vars_of_alloc ();
-
- /* This calls Fmake_glyph_internal(). */
#ifdef HAVE_MENUBARS
complex_vars_of_menubar ();
#endif
＠＠ -2439,6 +2449,8 ＠＠ main_1 (int argc, Wexttext **argv, Wextt
might depend on all sorts of things; I'm not sure. */
complex_vars_of_emacs ();
+ complex_vars_of_gc ();
+
/* This creates a couple of basic keymaps and depends on Lisp
hash tables and Ffset() (both of which depend on some variables
initialized in the vars_of_*() section) and possibly other
＠＠ -2449,7 +2461,11 ＠＠ main_1 (int argc, Wexttext **argv, Wextt
{
extern int always_gc;
if (always_gc) /* purification debugging hack */
+#ifdef NEW_GC
+ gc_full ();
+#else /* not NEW_GC */
garbage_collect_1 ();
+#endif /* not NEW_GC */
}
#endif
}
＠＠ -2928,7 +2944,11 ＠＠ Do not call this. It will reinitialize
{
int i;
+#ifdef NEW_GC
+ if (gc_in_progress) gc_full ();
+#else /* not NEW_GC */
assert (!gc_in_progress);
+#endif /* not NEW_GC */
if (run_temacs_argc < 0)
invalid_operation ("I've lost my temacs-hood", Qunbound);
＠＠ -3204,7 +3224,11 ＠＠ and announce itself normally when it is
memory_warnings (my_edata, malloc_warning);
#endif
+#ifdef NEW_GC
+ gc_full ();
+#else /* not NEW_GC */
garbage_collect_1 ();
+#endif /* not NEW_GC */
#ifdef PDUMP
pdump ();
＠＠ -3728,12 +3752,28 ＠＠ fatal_error_signal (int sig)
guts_of_fatal_error_signal (sig);
+#ifdef NEW_GC
+ /* This time the signal will really be fatal. To be able to debug
+ SIGSEGV and SIGBUS also during write barrier, send SIGABRT. */
+#ifdef WIN32_NATIVE
+ if (sig == SIGSEGV)
+ raise (SIGABRT);
+ else
+ raise (sig);
+#else
+ if ((sig == SIGSEGV) || (sig == SIGBUS))
+ kill (qxe_getpid (), SIGABRT);
+ else
+ kill (qxe_getpid (), sig);
+#endif
+#else /* not NEW_GC */
/* Signal the same code; this time it will really be fatal. */
#ifdef WIN32_NATIVE
raise (sig);
#else
kill (qxe_getpid (), sig);
#endif
+#endif /* not NEW_GC */
SIGRETURN;
}
1.91 +45 -0 XEmacs/xemacs/src/eval.c
Index: eval.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/eval.c,v
retrieving revision 1.90
retrieving revision 1.91
diff -u -p -r1.90 -r1.91
--- eval.c 2005/10/25 11:16:23 1.90
+++ eval.c 2005/11/25 01:42:00 1.91
＠＠ -2238,7 +2238,9 ＠＠ user invokes the "return from signal" op
ABORT ();
}
+#ifndef NEW_GC
assert (!gc_in_progress);
+#endif /* not NEW_GC */
/* We abort if in_display and we are not protected, as garbage
collections and non-local exits will invariably be fatal, but in
＠＠ -3371,14 +3373,32 ＠＠ handle_compiled_function_with_and_rest (
int bindargs = min (nargs, max_non_rest_args);
for (i = 0; i < bindargs; i++)
+#ifdef NEW_GC
+ SPECBIND_FAST_UNSAFE (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i],
+ args[i]);
+#else /* not NEW_GC */
SPECBIND_FAST_UNSAFE (f->args[i], args[i]);
+#endif /* not NEW_GC */
for (i = bindargs; i < max_non_rest_args; i++)
+#ifdef NEW_GC
+ SPECBIND_FAST_UNSAFE (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i],
+ Qnil);
+#else /* not NEW_GC */
SPECBIND_FAST_UNSAFE (f->args[i], Qnil);
+#endif /* not NEW_GC */
+#ifdef NEW_GC
SPECBIND_FAST_UNSAFE
+ (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[max_non_rest_args],
+ nargs > max_non_rest_args ?
+ Flist (nargs - max_non_rest_args, &args[max_non_rest_args]) :
+ Qnil);
+#else /* not NEW_GC */
+ SPECBIND_FAST_UNSAFE
(f->args[max_non_rest_args],
nargs > max_non_rest_args ?
Flist (nargs - max_non_rest_args, &args[max_non_rest_args]) :
Qnil);
+#endif /* not NEW_GC */
}
/* Apply compiled-function object FUN to the NARGS evaluated arguments
＠＠ -3405,7 +3425,12 ＠＠ funcall_compiled_function (Lisp_Object f
{
#if 1
for (i = 0; i < nargs; i++)
+#ifdef NEW_GC
+ SPECBIND_FAST_UNSAFE (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i],
+ args[i]);
+#else /* not NEW_GC */
SPECBIND_FAST_UNSAFE (f->args[i], args[i]);
+#endif /* not NEW_GC */
#else
/* Here's an alternate way to write the loop that tries to further
optimize funcalls for functions with few arguments by partially
＠＠ -3436,9 +3461,19 ＠＠ funcall_compiled_function (Lisp_Object f
else if (nargs < f->max_args)
{
for (i = 0; i < nargs; i++)
+#ifdef NEW_GC
+ SPECBIND_FAST_UNSAFE (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i],
+ args[i]);
+#else /* not NEW_GC */
SPECBIND_FAST_UNSAFE (f->args[i], args[i]);
+#endif /* not NEW_GC */
for (i = nargs; i < f->max_args; i++)
+#ifdef NEW_GC
+ SPECBIND_FAST_UNSAFE (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i],
+ Qnil);
+#else /* not NEW_GC */
SPECBIND_FAST_UNSAFE (f->args[i], Qnil);
+#endif /* not NEW_GC */
}
else if (f->max_args == MANY)
handle_compiled_function_with_and_rest (f, nargs, args);
＠＠ -3527,7 +3562,11 ＠＠ Evaluate FORM and return its value.
{
struct gcpro gcpro1;
GCPRO1 (form);
+#ifdef NEW_GC
+ gc_incremental ();
+#else /* not NEW_GC */
garbage_collect_1 ();
+#endif /* not NEW_GC */
UNGCPRO;
}
＠＠ -3779,7 +3818,11 ＠＠ Thus, (funcall 'cons 'x 'y) returns (x .
{
if (need_to_garbage_collect)
/* Callers should gcpro lexpr args */
+#ifdef NEW_GC
+ gc_incremental ();
+#else /* not NEW_GC */
garbage_collect_1 ();
+#endif /* not NEW_GC */
if (need_to_check_c_alloca)
{
if (++funcall_alloca_count >= MAX_FUNCALLS_BETWEEN_ALLOCA_CLEANUP)
＠＠ -4305,9 +4348,11 ＠＠ run_hook_with_args_in_buffer (struct buf
/* We need to bail out of here pronto. */
return Qnil;
+#ifndef NEW_GC
/* Whenever gc_in_progress is true, preparing_for_armageddon
will also be true unless something is really hosed. */
assert (!gc_in_progress);
+#endif /* not NEW_GC */
sym = args[0];
val = symbol_value_in_buffer (sym, wrap_buffer (buf));
1.106 +2 -0 XEmacs/xemacs/src/event-msw.c
Index: event-msw.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/event-msw.c,v
retrieving revision 1.105
retrieving revision 1.106
diff -u -p -r1.105 -r1.106
--- event-msw.c 2005/10/25 11:16:23 1.105
+++ event-msw.c 2005/11/25 01:42:01 1.106
＠＠ -2498,9 +2498,11 ＠＠ mswindows_wnd_proc (HWND hwnd, UINT mess
struct frame *frame;
struct mswindows_frame *msframe;
+#ifndef NEW_GC
/* If you hit this, rewrite the offending API call to occur after GC,
using register_post_gc_action(). */
assert (!gc_in_progress);
+#endif /* NEW_GC */
#ifdef DEBUG_XEMACS
if (debug_mswindows_events)
1.71 +3 -0 XEmacs/xemacs/src/events.c
Index: events.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/events.c,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -p -r1.70 -r1.71
--- events.c 2005/11/13 10:48:03 1.70
+++ events.c 2005/11/25 01:42:01 1.71
＠＠ -2650,6 +2650,9 ＠＠ void
reinit_vars_of_events (void)
{
Vevent_resource = Qnil;
+#ifdef NEW_GC
+ staticpro (&Vevent_resource);
+#endif /* NEW_GC */
}
void
1.63 +160 -0 XEmacs/xemacs/src/extents.c
Index: extents.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/extents.c,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -p -r1.62 -r1.63
--- extents.c 2005/10/25 11:16:23 1.62
+++ extents.c 2005/11/25 01:42:01 1.63
＠＠ -242,6 +242,9 ＠＠ Boston, MA 02111-1307, USA. */
typedef struct gap_array_marker
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
int pos;
struct gap_array_marker *next;
} Gap_Array_Marker;
＠＠ -269,6 +272,9 ＠＠ typedef struct gap_array_marker
typedef struct gap_array
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
Elemcount gap;
Elemcount gapsize;
Elemcount numels;
＠＠ -281,7 +287,9 ＠＠ typedef struct gap_array
char array[1];
} Gap_Array;
+#ifndef NEW_GC
static Gap_Array_Marker *gap_array_marker_freelist;
+#endif /* not NEW_GC */
/* Convert a "memory position" (i.e. taking the gap into account) into
the address of the element at (i.e. after) that position. "Memory
＠＠ -310,6 +318,9 ＠＠ static Gap_Array_Marker *gap_array_marke
typedef struct extent_list_marker
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
Gap_Array_Marker *m;
int endp;
struct extent_list_marker *next;
＠＠ -317,12 +328,17 ＠＠ typedef struct extent_list_marker
typedef struct extent_list
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
Gap_Array *start;
Gap_Array *end;
Extent_List_Marker *markers;
} Extent_List;
+#ifndef NEW_GC
static Extent_List_Marker *extent_list_marker_freelist;
+#endif /* not NEW_GC */
#define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \
((extent_start (e) == (st)) && \
＠＠ -377,6 +393,9 ＠＠ struct extent_auxiliary extent_auxiliary
typedef struct stack_of_extents
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
Extent_List *extents;
Memxpos pos; /* Position of stack of extents. EXTENTS is the list of
all extents that overlap this position. This position
＠＠ -569,10 +588,17 ＠＠ gap_array_make_gap (Gap_Array *ga, Elemc
a geometric progression that saves on realloc space. */
increment += 100 + ga->numels / 8;
+#ifdef NEW_GC
+ ga = (Gap_Array *) mc_realloc (ga,
+ offsetof (Gap_Array, array) +
+ (ga->numels + ga->gapsize + increment) *
+ ga->elsize);
+#else /* not NEW_GC */
ga = (Gap_Array *) xrealloc (ga,
offsetof (Gap_Array, array) +
(ga->numels + ga->gapsize + increment) *
ga->elsize);
+#endif /* not NEW_GC */
if (ga == 0)
memory_full ();
＠＠ -664,6 +690,9 ＠＠ gap_array_make_marker (Gap_Array *ga, El
Gap_Array_Marker *m;
assert (pos >= 0 && pos <= ga->numels);
+#ifdef NEW_GC
+ m = alloc_lrecord_type (Gap_Array_Marker, &lrecord_gap_array_marker);
+#else /* not NEW_GC */
if (gap_array_marker_freelist)
{
m = gap_array_marker_freelist;
＠＠ -671,6 +700,7 ＠＠ gap_array_make_marker (Gap_Array *ga, El
}
else
m = xnew (Gap_Array_Marker);
+#endif /* not NEW_GC */
m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
m->next = ga->markers;
＠＠ -690,11 +720,16 ＠＠ gap_array_delete_marker (Gap_Array *ga,
prev->next = p->next;
else
ga->markers = p->next;
+#ifdef NEW_GC
+ mc_free (m);
+#else /* not NEW_GC */
m->next = gap_array_marker_freelist;
m->pos = 0xDEADBEEF; /* -559038737 base 10 */
gap_array_marker_freelist = m;
+#endif /* not NEW_GC */
}
+#ifndef NEW_GC
static void
gap_array_delete_all_markers (Gap_Array *ga)
{
＠＠ -708,6 +743,7 ＠＠ gap_array_delete_all_markers (Gap_Array
gap_array_marker_freelist = p;
}
}
+#endif /* not NEW_GC */
static void
gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, Elemcount pos)
＠＠ -722,17 +758,23 ＠＠ gap_array_move_marker (Gap_Array *ga, Ga
static Gap_Array *
make_gap_array (Elemcount elsize)
{
+#ifdef NEW_GC
+ Gap_Array *ga = alloc_lrecord_type (Gap_Array, &lrecord_gap_array);
+#else /* not NEW_GC */
Gap_Array *ga = xnew_and_zero (Gap_Array);
+#endif /* not NEW_GC */
ga->elsize = elsize;
return ga;
}
+#ifndef NEW_GC
static void
free_gap_array (Gap_Array *ga)
{
gap_array_delete_all_markers (ga);
xfree (ga, Gap_Array *);
}
+#endif /* not NEW_GC */
/************************************************************************/
＠＠ -887,6 +929,9 ＠＠ extent_list_make_marker (Extent_List *el
{
Extent_List_Marker *m;
+#ifdef NEW_GC
+ m = alloc_lrecord_type (Extent_List_Marker, &lrecord_extent_list_marker);
+#else /* not NEW_GC */
if (extent_list_marker_freelist)
{
m = extent_list_marker_freelist;
＠＠ -894,6 +939,7 ＠＠ extent_list_make_marker (Extent_List *el
}
else
m = xnew (Extent_List_Marker);
+#endif /* not NEW_GC */
m->m = gap_array_make_marker (endp ? el->end : el->start, pos);
m->endp = endp;
＠＠ -917,9 +963,13 ＠＠ extent_list_delete_marker (Extent_List *
prev->next = p->next;
else
el->markers = p->next;
+#ifdef NEW_GC
+ gap_array_delete_marker (m->endp ? el->end : el->start, m->m);
+#else /* not NEW_GC */
m->next = extent_list_marker_freelist;
extent_list_marker_freelist = m;
gap_array_delete_marker (m->endp ? el->end : el->start, m->m);
+#endif /* not NEW_GC */
}
#define extent_list_marker_pos(el, mkr) \
＠＠ -928,13 +978,18 ＠＠ extent_list_delete_marker (Extent_List *
static Extent_List *
allocate_extent_list (void)
{
+#ifdef NEW_GC
+ Extent_List *el = alloc_lrecord_type (Extent_List, &lrecord_extent_list);
+#else /* not NEW_GC */
Extent_List *el = xnew (Extent_List);
+#endif /* not NEW_GC */
el->start = make_gap_array (sizeof (EXTENT));
el->end = make_gap_array (sizeof (EXTENT));
el->markers = 0;
return el;
}
+#ifndef NEW_GC
static void
free_extent_list (Extent_List *el)
{
＠＠ -942,6 +997,7 ＠＠ free_extent_list (Extent_List *el)
free_gap_array (el->end);
xfree (el, Extent_List *);
}
+#endif /* not NEW_GC */
/************************************************************************/
＠＠ -1021,28 +1077,46 ＠＠ allocate_extent_auxiliary (EXTENT ext)
structure to be there. */
static struct stack_of_extents *allocate_soe (void);
+#ifndef NEW_GC
static void free_soe (struct stack_of_extents *soe);
+#endif /* not NEW_GC */
static void soe_invalidate (Lisp_Object obj);
extern const struct sized_memory_description gap_array_marker_description;
static const struct memory_description gap_array_marker_description_1[] = {
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, offsetof (Gap_Array_Marker, next) },
+#else /* not NEW_GC */
{ XD_BLOCK_PTR, offsetof (Gap_Array_Marker, next), 1,
{ &gap_array_marker_description } },
+#endif /* not NEW_GC */
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("gap-array-marker", gap_array_marker,
+ 0, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ gap_array_marker_description_1,
+ struct gap_array_marker);
+#else /* not NEW_GC */
const struct sized_memory_description gap_array_marker_description = {
sizeof (Gap_Array_Marker),
gap_array_marker_description_1
};
+#endif /* not NEW_GC */
static const struct memory_description lispobj_gap_array_description_1[] = {
{ XD_ELEMCOUNT, offsetof (Gap_Array, gap) },
{ XD_BYTECOUNT, offsetof (Gap_Array, offset_past_gap) },
{ XD_ELEMCOUNT, offsetof (Gap_Array, els_past_gap) },
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, offsetof (Gap_Array, markers) },
+#else /* not NEW_GC */
{ XD_BLOCK_PTR, offsetof (Gap_Array, markers), 1,
{ &gap_array_marker_description }, XD_FLAG_NO_KKCC },
+#endif /* not NEW_GC */
{ XD_BLOCK_ARRAY, offsetof (Gap_Array, array), XD_INDIRECT (0, 0),
{ &lisp_object_description } },
{ XD_BLOCK_ARRAY, XD_INDIRECT (1, offsetof (Gap_Array, array)),
＠＠ -1050,57 +1124,118 ＠＠ static const struct memory_description l
{ XD_END }
};
+#ifdef NEW_GC
+
+static Bytecount
+size_gap_array (const void *lheader)
+{
+ Gap_Array *ga = (Gap_Array *) lheader;
+ return offsetof (Gap_Array, array) + (ga->numels + ga->gapsize) * ga->elsize;
+}
+
+DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("gap-array", gap_array,
+ 0, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ lispobj_gap_array_description_1,
+ size_gap_array,
+ struct gap_array);
+#else /* not NEW_GC */
static const struct sized_memory_description lispobj_gap_array_description = {
sizeof (Gap_Array),
lispobj_gap_array_description_1
};
extern const struct sized_memory_description extent_list_marker_description;
+#endif /* not NEW_GC */
static const struct memory_description extent_list_marker_description_1[] = {
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, offsetof (Extent_List_Marker, m) },
+ { XD_LISP_OBJECT, offsetof (Extent_List_Marker, next) },
+#else /* not NEW_GC */
{ XD_BLOCK_PTR, offsetof (Extent_List_Marker, m), 1,
{ &gap_array_marker_description } },
{ XD_BLOCK_PTR, offsetof (Extent_List_Marker, next), 1,
{ &extent_list_marker_description } },
+#endif /* not NEW_GC */
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("extent-list-marker", extent_list_marker,
+ 0, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ extent_list_marker_description_1,
+ struct extent_list_marker);
+#else /* not NEW_GC */
const struct sized_memory_description extent_list_marker_description = {
sizeof (Extent_List_Marker),
extent_list_marker_description_1
};
+#endif /* not NEW_GC */
static const struct memory_description extent_list_description_1[] = {
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, offsetof (Extent_List, start) },
+ { XD_LISP_OBJECT, offsetof (Extent_List, end) },
+ { XD_LISP_OBJECT, offsetof (Extent_List, markers) },
+#else /* not NEW_GC */
{ XD_BLOCK_PTR, offsetof (Extent_List, start), 1,
{ &lispobj_gap_array_description } },
{ XD_BLOCK_PTR, offsetof (Extent_List, end), 1,
{ &lispobj_gap_array_description }, XD_FLAG_NO_KKCC },
{ XD_BLOCK_PTR, offsetof (Extent_List, markers), 1,
{ &extent_list_marker_description }, XD_FLAG_NO_KKCC },
+#endif /* not NEW_GC */
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("extent-list", extent_list,
+ 0, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ extent_list_description_1,
+ struct extent_list);
+#else /* not NEW_GC */
static const struct sized_memory_description extent_list_description = {
sizeof (Extent_List),
extent_list_description_1
};
+#endif /* not NEW_GC */
static const struct memory_description stack_of_extents_description_1[] = {
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, offsetof (Stack_Of_Extents, extents) },
+#else /* not NEW_GC */
{ XD_BLOCK_PTR, offsetof (Stack_Of_Extents, extents), 1,
{ &extent_list_description } },
+#endif /* not NEW_GC */
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("stack-of-extents", stack_of_extents,
+ 0, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ stack_of_extents_description_1,
+ struct stack_of_extents);
+#else /* not NEW_GC */
static const struct sized_memory_description stack_of_extents_description = {
sizeof (Stack_Of_Extents),
stack_of_extents_description_1
};
+#endif /* not NEW_GC */
static const struct memory_description extent_info_description [] = {
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, offsetof (struct extent_info, extents) },
+ { XD_LISP_OBJECT, offsetof (struct extent_info, soe) },
+#else /* not NEW_GC */
{ XD_BLOCK_PTR, offsetof (struct extent_info, extents), 1,
{ &extent_list_description } },
{ XD_BLOCK_PTR, offsetof (struct extent_info, soe), 1,
{ &stack_of_extents_description }, XD_FLAG_NO_KKCC },
+#endif /* not NEW_GC */
{ XD_END }
};
＠＠ -1142,6 +1277,10 ＠＠ finalize_extent_info (void *header, int
if (for_disksave)
return;
+#ifdef NEW_GC
+ data->soe = 0;
+ data->extents = 0;
+#else /* not NEW_GC */
if (data->soe)
{
free_soe (data->soe);
＠＠ -1152,6 +1291,7 ＠＠ finalize_extent_info (void *header, int
free_extent_list (data->extents);
data->extents = 0;
}
+#endif /* not NEW_GC */
}
DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info,
＠＠ -1181,7 +1321,9 ＠＠ flush_cached_extent_info (Lisp_Object ex
if (data->soe)
{
+#ifndef NEW_GC
free_soe (data->soe);
+#endif /* not NEW_GC */
data->soe = 0;
}
}
＠＠ -1326,12 +1468,16 ＠＠ init_buffer_extents (struct buffer *b)
void
uninit_buffer_extents (struct buffer *b)
{
+#ifndef NEW_GC
struct extent_info *data = XEXTENT_INFO (b->extent_info);
+#endif /* not NEW_GC */
/* Don't destroy the extents here -- there may still be children
extents pointing to the extents. */
detach_all_extents (wrap_buffer (b));
+#ifndef NEW_GC
finalize_extent_info (data, 0);
+#endif /* not NEW_GC */
}
/* Retrieve the extent list that an extent is a member of; the
＠＠ -1649,18 +1795,25 ＠＠ soe_invalidate (Lisp_Object obj)
static struct stack_of_extents *
allocate_soe (void)
{
+#ifdef NEW_GC
+ struct stack_of_extents *soe =
+ alloc_lrecord_type (struct stack_of_extents, &lrecord_stack_of_extents);
+#else /* not NEW_GC */
struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents);
+#endif /* not NEW_GC */
soe->extents = allocate_extent_list ();
soe->pos = -1;
return soe;
}
+#ifndef NEW_GC
static void
free_soe (struct stack_of_extents *soe)
{
free_extent_list (soe->extents);
xfree (soe, struct stack_of_extents *);
}
+#endif /* not NEW_GC */
/* ------------------------------- */
/* other primitives */
＠＠ -7299,6 +7452,13 ＠＠ syms_of_extents (void)
INIT_LRECORD_IMPLEMENTATION (extent);
INIT_LRECORD_IMPLEMENTATION (extent_info);
INIT_LRECORD_IMPLEMENTATION (extent_auxiliary);
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (gap_array_marker);
+ INIT_LRECORD_IMPLEMENTATION (gap_array);
+ INIT_LRECORD_IMPLEMENTATION (extent_list_marker);
+ INIT_LRECORD_IMPLEMENTATION (extent_list);
+ INIT_LRECORD_IMPLEMENTATION (stack_of_extents);
+#endif /* not NEW_GC */
DEFSYMBOL (Qextentp);
DEFSYMBOL (Qextent_live_p);
1.20 +50 -0 XEmacs/xemacs/src/extents.h
Index: extents.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/extents.h,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -p -r1.19 -r1.20
--- extents.h 2005/01/26 05:11:12 1.19
+++ extents.h 2005/11/25 01:42:02 1.20
＠＠ -49,6 +49,56 ＠＠ DECLARE_LRECORD (extent_info, struct ext
#define CHECK_EXTENT_INFO(x) CHECK_RECORD (x, extent_info)
#define CONCHECK_EXTENT_INFO(x) CONCHECK_RECORD (x, extent_info)
+#ifdef NEW_GC
+struct gap_array_marker;
+
+DECLARE_LRECORD (gap_array_marker, struct gap_array_marker);
+#define XGAP_ARRAY_MARKER(x) \
+ XRECORD (x, gap_array_marker, struct gap_array_marker)
+#define wrap_gap_array_marker(p) wrap_record (p, gap_array_marker)
+#define GAP_ARRAY_MARKERP(x) RECORDP (x, gap_array_marker)
+#define CHECK_GAP_ARRAY_MARKER(x) CHECK_RECORD (x, gap_array_marker)
+#define CONCHECK_GAP_ARRAY_MARKER(x) CONCHECK_RECORD (x, gap_array_marker)
+
+struct gap_array;
+
+DECLARE_LRECORD (gap_array, struct gap_array);
+#define XGAP_ARRAY(x) XRECORD (x, gap_array, struct gap_array)
+#define wrap_gap_array(p) wrap_record (p, gap_array)
+#define GAP_ARRAYP(x) RECORDP (x, gap_array)
+#define CHECK_GAP_ARRAY(x) CHECK_RECORD (x, gap_array)
+#define CONCHECK_GAP_ARRAY(x) CONCHECK_RECORD (x, gap_array)
+
+struct extent_list_marker;
+
+DECLARE_LRECORD (extent_list_marker, struct extent_list_marker);
+#define XEXTENT_LIST_MARKER(x) \
+ XRECORD (x, extent_list_marker, struct extent_list_marker)
+#define wrap_extent_list_marker(p) wrap_record (p, extent_list_marker)
+#define EXTENT_LIST_MARKERP(x) RECORDP (x, extent_list_marker)
+#define CHECK_EXTENT_LIST_MARKER(x) CHECK_RECORD (x, extent_list_marker)
+#define CONCHECK_EXTENT_LIST_MARKER(x) CONCHECK_RECORD (x, extent_list_marker)
+
+struct extent_list;
+
+DECLARE_LRECORD (extent_list, struct extent_list);
+#define XEXTENT_LIST(x) XRECORD (x, extent_list, struct extent_list)
+#define wrap_extent_list(p) wrap_record (p, extent_list)
+#define EXTENT_LISTP(x) RECORDP (x, extent_list)
+#define CHECK_EXTENT_LIST(x) CHECK_RECORD (x, extent_list)
+#define CONCHECK_EXTENT_LIST(x) CONCHECK_RECORD (x, extent_list)
+
+struct stack_of_extents;
+
+DECLARE_LRECORD (stack_of_extents, struct stack_of_extents);
+#define XSTACK_OF_EXTENTS(x) \
+ XRECORD (x, stack_of_extents, struct stack_of_extents)
+#define wrap_stack_of_extents(p) wrap_record (p, stack_of_extents)
+#define STACK_OF_EXTENTSP(x) RECORDP (x, stack_of_extents)
+#define CHECK_STACK_OF_EXTENTS(x) CHECK_RECORD (x, stack_of_extents)
+#define CONCHECK_STACK_OF_EXTENTS(x) CONCHECK_RECORD (x, stack_of_extents)
+#endif /* NEW_GC */
+
/* the layouts for glyphs (extent->flags.glyph_layout). Must fit in 2 bits. */
typedef enum glyph_layout
{
1.15 +16 -0 XEmacs/xemacs/src/faces.h
Index: faces.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.h,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -p -r1.14 -r1.15
--- faces.h 2005/10/24 10:07:36 1.14
+++ faces.h 2005/11/25 01:42:02 1.15
＠＠ -117,6 +117,9 ＠＠ struct Lisp_Face
typedef struct face_cachel face_cachel;
struct face_cachel
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* not NEW_GC */
/* There are two kinds of cachels; those created from a single face
and those created by merging more than one face. In the former
case, the FACE element specifies the face used. In the latter
＠＠ -221,6 +224,19 ＠＠ struct face_cachel
/* #### Of course we should use a bit array or something. */
unsigned char font_updated[NUM_LEADING_BYTES];
};
+
+#ifdef NEW_GC
+typedef struct face_cachel Lisp_Face_Cachel;
+
+DECLARE_LRECORD (face_cachel, Lisp_Face_Cachel);
+
+#define XFACE_CACHEL(x) \
+ XRECORD (x, face_cachel, Lisp_Face_Cachel)
+#define wrap_face_cachel(p) wrap_record (p, face_cachel)
+#define FACE_CACHEL_P(x) RECORDP (x, face_cachel)
+#define CHECK_FACE_CACHEL(x) CHECK_RECORD (x, face_cachel)
+#define CONCHECK_FACE_CACHEL(x) CONCHECK_RECORD (x, face_cachel)
+#endif /* NEW_GC */
DECLARE_LRECORD (face, Lisp_Face);
#define XFACE(x) XRECORD (x, face, Lisp_Face)
1.22 +20 -0 XEmacs/xemacs/src/frame-gtk.c
Index: frame-gtk.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frame-gtk.c,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -p -r1.21 -r1.22
--- frame-gtk.c 2005/11/22 11:24:44 1.21
+++ frame-gtk.c 2005/11/25 01:42:02 1.22
＠＠ -102,11 +102,19 ＠＠ static const struct memory_description g
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("gtk-frame", gtk_frame,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ gtk_frame_data_description_1,
+ Lisp_Gtk_Frame);
+#else /* not NEW_GC */
extern const struct sized_memory_description gtk_frame_data_description;
const struct sized_memory_description gtk_frame_data_description = {
sizeof (struct gtk_frame), gtk_frame_data_description_1
};
+#endif /* not NEW_GC */
/************************************************************************/
＠＠ -966,7 +974,11 ＠＠ allocate_gtk_frame_struct (struct frame
int i;
/* zero out all slots. */
+#ifdef NEW_GC
+ f->frame_data = alloc_lrecord_type (struct gtk_frame, &lrecord_gtk_frame);
+#else /* not NEW_GC */
f->frame_data = xnew_and_zero (struct gtk_frame);
+#endif /* not NEW_GC */
/* yeah, except the lisp ones */
FRAME_GTK_ICON_PIXMAP (f) = Qnil;
＠＠ -1342,7 +1354,11 ＠＠ gtk_delete_frame (struct frame *f)
if (FRAME_GTK_GEOM_FREE_ME_PLEASE (f))
xfree (FRAME_GTK_GEOM_FREE_ME_PLEASE (f), char *);
+#ifdef NEW_GC
+ mc_free (f->frame_data);
+#else /* not NEW_GC */
xfree (f->frame_data, void *);
+#endif /* not NEW_GC */
f->frame_data = 0;
}
＠＠ -1447,6 +1463,10 ＠＠ gtk_update_frame_external_traits (struct
void
syms_of_frame_gtk (void)
{
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (gtk_frame);
+#endif /* NEW_GC */
+
DEFSYMBOL (Qtext_widget);
DEFSYMBOL (Qcontainer_widget);
DEFSYMBOL (Qshell_widget);
1.59 +20 -0 XEmacs/xemacs/src/frame-msw.c
Index: frame-msw.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frame-msw.c,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -p -r1.58 -r1.59
--- frame-msw.c 2005/10/25 07:30:42 1.58
+++ frame-msw.c 2005/11/25 01:42:02 1.59
＠＠ -92,11 +92,19 ＠＠ static const struct memory_description m
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("mswindows-frame", mswindows_frame,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ mswindows_frame_data_description_1,
+ Lisp_Mswindows_Frame);
+#else /* not NEW_GC */
extern const struct sized_memory_description mswindows_frame_data_description;
const struct sized_memory_description mswindows_frame_data_description = {
sizeof (struct mswindows_frame), mswindows_frame_data_description_1
};
+#endif /* not NEW_GC */
/*---------------------------------------------------------------------*/
/*----- DISPLAY FRAME -----*/
＠＠ -165,7 +173,12 ＠＠ mswindows_init_frame_1 (struct frame *f,
if (!NILP (height))
CHECK_INT (height);
+#ifdef NEW_GC
+ f->frame_data = alloc_lrecord_type (struct mswindows_frame,
+ &lrecord_mswindows_frame);
+#else /* not NEW_GC */
f->frame_data = xnew_and_zero (struct mswindows_frame);
+#endif /* not NEW_GC */
FRAME_MSWINDOWS_TARGET_RECT (f) = xnew_and_zero (XEMACS_RECT_WH);
FRAME_MSWINDOWS_TARGET_RECT (f)->left = NILP (left) ? -1 : abs (XINT (left));
＠＠ -340,7 +353,11 ＠＠ mswindows_delete_frame (struct frame *f)
#endif
ReleaseDC (FRAME_MSWINDOWS_HANDLE (f), FRAME_MSWINDOWS_DC (f));
DestroyWindow (FRAME_MSWINDOWS_HANDLE (f));
+#ifdef NEW_GC
+ mc_free (f->frame_data);
+#else /* not NEW_GC */
xfree (f->frame_data, void *);
+#endif /* not NEW_GC */
}
f->frame_data = 0;
}
＠＠ -1185,6 +1202,9 ＠＠ console_type_create_frame_mswindows (voi
void
syms_of_frame_mswindows (void)
{
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (mswindows_frame);
+#endif /* NEW_GC */
}
void
1.71 +20 -0 XEmacs/xemacs/src/frame-x.c
Index: frame-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frame-x.c,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -p -r1.70 -r1.71
--- frame-x.c 2005/04/27 09:01:48 1.70
+++ frame-x.c 2005/11/25 01:42:02 1.71
＠＠ -77,11 +77,19 ＠＠ static const struct memory_description x
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("x-frame", x_frame,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ x_frame_data_description_1,
+ Lisp_X_Frame);
+#else /* not NEW_GC */
extern const struct sized_memory_description x_frame_data_description;
const struct sized_memory_description x_frame_data_description = {
sizeof (struct x_frame), x_frame_data_description_1
};
+#endif /* not NEW_GC */
EXFUN (Fx_window_id, 1);
＠＠ -2073,7 +2081,11 ＠＠ static void
allocate_x_frame_struct (struct frame *f)
{
/* zero out all slots. */
+#ifdef NEW_GC
+ f->frame_data = alloc_lrecord_type (struct x_frame, &lrecord_x_frame);
+#else /* not NEW_GC */
f->frame_data = xnew_and_zero (struct x_frame);
+#endif /* not NEW_GC */
/* yeah, except the lisp ones */
FRAME_X_LAST_MENUBAR_BUFFER (f) = Qnil;
＠＠ -2642,7 +2654,11 ＠＠ x_delete_frame (struct frame *f)
if (f->frame_data)
{
+#ifdef NEW_GC
+ mc_free (f->frame_data);
+#else /* not NEW_GC */
xfree (f->frame_data, void *);
+#endif /* not NEW_GC */
f->frame_data = 0;
}
}
＠＠ -2720,6 +2736,10 ＠＠ x_update_frame_external_traits (struct f
void
syms_of_frame_x (void)
{
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (x_frame);
+#endif /* NEW_GC */
+
DEFSYMBOL (Qoverride_redirect);
DEFSYMBOL (Qx_resource_name);
1.74 +40 -0 XEmacs/xemacs/src/frame.c
Index: frame.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frame.c,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -p -r1.73 -r1.74
--- frame.c 2005/10/25 11:16:24 1.73
+++ frame.c 2005/11/25 01:42:03 1.74
＠＠ -139,12 +139,25 ＠＠ static Ichar_dynarr *title_string_ichar_
+#ifndef NEW_GC
extern const struct sized_memory_description gtk_frame_data_description;
extern const struct sized_memory_description mswindows_frame_data_description;
extern const struct sized_memory_description x_frame_data_description;
+#endif /* not NEW_GC */
static const struct memory_description frame_data_description_1 []= {
+#ifdef NEW_GC
#ifdef HAVE_GTK
+ { XD_LISP_OBJECT, gtk_console },
+#endif
+#ifdef HAVE_MS_WINDOWS
+ { XD_LISP_OBJECT, mswindows_console },
+#endif
+#ifdef HAVE_X_WINDOWS
+ { XD_LISP_OBJECT, x_console },
+#endif
+#else /* not NEW_GC */
+#ifdef HAVE_GTK
{ XD_BLOCK_PTR, gtk_console, 1, { >k_frame_data_description} },
#endif
#ifdef HAVE_MS_WINDOWS
＠＠ -153,6 +166,7 ＠＠ static const struct memory_description f
#ifdef HAVE_X_WINDOWS
{ XD_BLOCK_PTR, x_console, 1, { &x_frame_data_description} },
#endif
+#endif /* not NEW_GC */
{ XD_END }
};
＠＠ -160,6 +174,19 ＠＠ static const struct sized_memory_descrip
sizeof (void *), frame_data_description_1
};
+#ifdef NEW_GC
+static const struct memory_description expose_ignore_description_1 [] = {
+ { XD_LISP_OBJECT, offsetof (struct expose_ignore, next) },
+ { XD_END }
+};
+
+DEFINE_LRECORD_IMPLEMENTATION ("expose-ignore",
+ expose_ignore,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ expose_ignore_description_1,
+ struct expose_ignore);
+#else /* not NEW_GC */
extern const struct sized_memory_description expose_ignore_description;
static const struct memory_description expose_ignore_description_1 [] = {
＠＠ -172,6 +199,7 ＠＠ const struct sized_memory_description ex
sizeof (struct expose_ignore),
expose_ignore_description_1
};
+#endif /* not NEW_GC */
static const struct memory_description display_line_dynarr_pointer_description_1 []= {
{ XD_BLOCK_PTR, 0, 1, { &display_line_dynarr_description} },
＠＠ -189,10 +217,15 ＠＠ static const struct memory_description f
{ XD_LISP_OBJECT_ARRAY, offsetof (struct frame, slot), size },
#include "frameslots.h"
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, offsetof (struct frame, subwindow_exposures) },
+ { XD_LISP_OBJECT, offsetof (struct frame, subwindow_exposures_tail) },
+#else /* not NEW_GC */
{ XD_BLOCK_PTR, offsetof (struct frame, subwindow_exposures),
1, { &expose_ignore_description } },
{ XD_BLOCK_PTR, offsetof (struct frame, subwindow_exposures_tail),
1, { &expose_ignore_description } },
+#endif /* not NEW_GC */
#ifdef HAVE_SCROLLBARS
{ XD_LISP_OBJECT, offsetof (struct frame, sb_vcache) },
＠＠ -3406,7 +3439,11 ＠＠ change_frame_size (struct frame *f, int
--andy. */
MARK_FRAME_SIZE_CHANGED (f);
+#ifdef NEW_GC
+ if (delay || hold_frame_size_changes)
+#else /* not NEW_GC */
if (delay || hold_frame_size_changes || gc_in_progress)
+#endif /* not NEW_GC */
{
f->new_width = newwidth;
f->new_height = newheight;
＠＠ -3576,6 +3613,9 ＠＠ void
syms_of_frame (void)
{
INIT_LRECORD_IMPLEMENTATION (frame);
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (expose_ignore);
+#endif /* NEW_GC */
DEFSYMBOL (Qdelete_frame_hook);
DEFSYMBOL (Qselect_frame_hook);
1.55 +12 -0 XEmacs/xemacs/src/glyphs.c
Index: glyphs.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs.c,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -p -r1.54 -r1.55
--- glyphs.c 2005/10/24 10:07:37 1.54
+++ glyphs.c 2005/11/25 01:42:04 1.55
＠＠ -4540,10 +4540,12 ＠＠ reset_frame_subwindow_instance_cache (st
expose events that are going to come and ignore them as
required. */
+#ifndef NEW_GC
struct expose_ignore_blocktype
{
Blocktype_declare (struct expose_ignore);
} *the_expose_ignore_blocktype;
+#endif /* not NEW_GC */
int
check_for_ignored_expose (struct frame* f, int x, int y, int width, int height)
＠＠ -4574,7 +4576,11 ＠＠ check_for_ignored_expose (struct frame*
if (ei == f->subwindow_exposures_tail)
f->subwindow_exposures_tail = prev;
+#ifdef NEW_GC
+ mc_free (ei);
+#else /* not NEW_GC */
Blocktype_free (the_expose_ignore_blocktype, ei);
+#endif /* not NEW_GC */
return 1;
}
prev = ei;
＠＠ -4589,7 +4595,11 ＠＠ register_ignored_expose (struct frame* f
{
struct expose_ignore *ei;
+#ifdef NEW_GC
+ ei = alloc_lrecord_type (struct expose_ignore, &lrecord_expose_ignore);
+#else /* not NEW_GC */
ei = Blocktype_alloc (the_expose_ignore_blocktype);
+#endif /* not NEW_GC */
ei->next = NULL;
ei->x = x;
＠＠ -5430,8 +5440,10 ＠＠ image_instantiator_format_create (void)
void
reinit_vars_of_glyphs (void)
{
+#ifndef NEW_GC
the_expose_ignore_blocktype =
Blocktype_new (struct expose_ignore_blocktype);
+#endif /* not NEW_GC */
hold_ignored_expose_registration = 0;
}
1.41 +28 -0 XEmacs/xemacs/src/glyphs.h
Index: glyphs.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs.h,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -p -r1.40 -r1.41
--- glyphs.h 2005/10/24 10:07:37 1.40
+++ glyphs.h 2005/11/25 01:42:04 1.41
＠＠ -1067,6 +1067,9 ＠＠ void disable_glyph_animated_timeout (int
typedef struct glyph_cachel glyph_cachel;
struct glyph_cachel
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* not NEW_GC */
Lisp_Object glyph;
unsigned int dirty :1; /* I'm copying faces here. I'm not
＠＠ -1082,6 +1085,19 ＠＠ struct glyph_cachel
unsigned short descent;
};
+#ifdef NEW_GC
+typedef struct glyph_cachel Lisp_Glyph_Cachel;
+
+DECLARE_LRECORD (glyph_cachel, Lisp_Glyph_Cachel);
+
+#define XGLYPH_CACHEL(x) \
+ XRECORD (x, glyph_cachel, Lisp_Glyph_Cachel)
+#define wrap_glyph_cachel(p) wrap_record (p, glyph_cachel)
+#define GLYPH_CACHEL_P(x) RECORDP (x, glyph_cachel)
+#define CHECK_GLYPH_CACHEL(x) CHECK_RECORD (x, glyph_cachel)
+#define CONCHECK_GLYPH_CACHEL(x) CONCHECK_RECORD (x, glyph_cachel)
+#endif /* NEW_GC */
+
#define CONT_GLYPH_INDEX (glyph_index) 0
#define TRUN_GLYPH_INDEX (glyph_index) 1
#define HSCROLL_GLYPH_INDEX (glyph_index) 2
＠＠ -1179,10 +1195,22 ＠＠ int unmap_subwindow_instance_cache_mappe
struct expose_ignore
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
int x, y;
int width, height;
struct expose_ignore *next;
};
+
+#ifdef NEW_GC
+DECLARE_LRECORD (expose_ignore, struct expose_ignore);
+#define XEXPOSE_IGNORE(x) XRECORD (x, expose_ignore, struct expose_ignore)
+#define wrap_expose_ignore(p) wrap_record (p, expose_ignore)
+#define EXPOSE_IGNOREP(x) RECORDP (x, expose_ignore)
+#define CHECK_EXPOSE_IGNORE(x) CHECK_RECORD (x, expose_ignore)
+#define CONCHECK_EXPOSE_IGNORE(x) CONCHECK_RECORD (x, expose_ignore)
+#endif /* NEW_GC */
int check_for_ignored_expose (struct frame* f, int x, int y, int width,
int height);
1.135 +373 -1 XEmacs/xemacs/src/lisp.h
Index: lisp.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v
retrieving revision 1.134
retrieving revision 1.135
diff -u -p -r1.134 -r1.135
--- lisp.h 2005/11/22 09:02:42 1.134
+++ lisp.h 2005/11/25 01:42:04 1.135
＠＠ -1253,6 +1253,7 ＠＠ do { \
/* ------------------------ dynamic arrays ------------------- */
+#ifndef NEW_GC
#ifdef ERROR_CHECK_STRUCTURES
#define Dynarr_declare(type) \
type *base; \
＠＠ -1380,6 +1381,7 ＠＠ Bytecount Dynarr_memory_usage (void *d,
void *stack_like_malloc (Bytecount size);
void stack_like_free (void *val);
+#endif /* not NEW_GC */
/************************************************************************/
/** Definitions of more complex types **/
＠＠ -1466,6 +1468,7 ＠＠ typedef struct Lisp_Font_Instance Lisp_F
typedef struct Lisp_Image_Instance Lisp_Image_Instance; /* glyphs.h */
typedef struct Lisp_Gui_Item Lisp_Gui_Item;
+#ifndef NEW_GC
/* ------------------------------- */
/* Dynarr typedefs */
/* ------------------------------- */
＠＠ -1550,6 +1553,7 ＠＠ typedef struct
{
Dynarr_declare (struct console_type_entry);
} console_type_entry_dynarr;
+#endif /* not NEW_GC */
/* ------------------------------- */
/* enum typedefs */
＠＠ -1666,6 +1670,7 ＠＠ enum Lisp_Type
#define XPNTR(x) ((void *) XPNTRVAL(x))
+#ifndef NEW_GC
/* WARNING WARNING WARNING. You must ensure on your own that proper
GC protection is provided for the elements in this array. */
typedef struct
＠＠ -1677,6 +1682,7 ＠＠ typedef struct
{
Dynarr_declare (Lisp_Object *);
} Lisp_Object_ptr_dynarr;
+#endif /* not NEW_GC */
/* Close your eyes now lest you vomit or spontaneously combust ... */
＠＠ -1707,6 +1713,284 ＠＠ END_C_DECLS
BEGIN_C_DECLS
+#ifdef NEW_GC
+/* ------------------------ dynamic arrays ------------------- */
+
+#ifdef ERROR_CHECK_STRUCTURES
+#define Dynarr_declare(type) \
+ struct lrecord_header header; \
+ type *base; \
+ const struct lrecord_implementation *lisp_imp; \
+ int locked; \
+ int elsize; \
+ int cur; \
+ int largest; \
+ int max
+#else
+#define Dynarr_declare(type) \
+ struct lrecord_header header; \
+ type *base; \
+ const struct lrecord_implementation *lisp_imp; \
+ int elsize; \
+ int cur; \
+ int largest; \
+ int max
+#endif /* ERROR_CHECK_STRUCTURES */
+
+typedef struct dynarr
+{
+ Dynarr_declare (void);
+} Dynarr;
+
+MODULE_API void *Dynarr_newf (int elsize);
+MODULE_API void Dynarr_resize (void *dy, Elemcount size);
+MODULE_API void Dynarr_insert_many (void *d, const void *el, int len, int start);
+MODULE_API void Dynarr_delete_many (void *d, int start, int len);
+MODULE_API void Dynarr_free (void *d);
+
+MODULE_API void *Dynarr_lisp_newf (int elsize,
+ const struct lrecord_implementation
+ *dynarr_imp,
+ const struct lrecord_implementation *imp);
+
+#define Dynarr_lisp_new(type, dynarr_imp, imp) \
+ ((type##_dynarr *) Dynarr_lisp_newf (sizeof (type), dynarr_imp, imp))
+#define Dynarr_lisp_new2(dynarr_type, type, dynarr_imp, imp) \
+ ((dynarr_type *) Dynarr_lisp_newf (sizeof (type)), dynarr_imp, imp)
+#define Dynarr_new(type) ((type##_dynarr *) Dynarr_newf (sizeof (type)))
+#define Dynarr_new2(dynarr_type, type) \
+ ((dynarr_type *) Dynarr_newf (sizeof (type)))
+#define Dynarr_at(d, pos) ((d)->base[pos])
+#define Dynarr_atp(d, pos) (&Dynarr_at (d, pos))
+#define Dynarr_begin(d) Dynarr_atp (d, 0)
+#define Dynarr_end(d) Dynarr_atp (d, Dynarr_length (d) - 1)
+#define Dynarr_sizeof(d) ((d)->cur * (d)->elsize)
+
+#ifdef ERROR_CHECK_STRUCTURES
+DECLARE_INLINE_HEADER (
+Dynarr *
+Dynarr_verify_1 (void *d, const Ascbyte *file, int line)
+)
+{
+ Dynarr *dy = (Dynarr *) d;
+ assert_at_line (dy->cur >= 0 && dy->cur <= dy->largest &&
+ dy->largest <= dy->max, file, line);
+ return dy;
+}
+
+DECLARE_INLINE_HEADER (
+Dynarr *
+Dynarr_verify_mod_1 (void *d, const Ascbyte *file, int line)
+)
+{
+ Dynarr *dy = (Dynarr *) d;
+ assert_at_line (!dy->locked, file, line);
+ assert_at_line (dy->cur >= 0 && dy->cur <= dy->largest &&
+ dy->largest <= dy->max, file, line);
+ return dy;
+}
+
+#define Dynarr_verify(d) Dynarr_verify_1 (d, __FILE__, __LINE__)
+#define Dynarr_verify_mod(d) Dynarr_verify_mod_1 (d, __FILE__, __LINE__)
+#define Dynarr_lock(d) (Dynarr_verify_mod (d)->locked = 1)
+#define Dynarr_unlock(d) ((d)->locked = 0)
+#else
+#define Dynarr_verify(d) (d)
+#define Dynarr_verify_mod(d) (d)
+#define Dynarr_lock(d)
+#define Dynarr_unlock(d)
+#endif /* ERROR_CHECK_STRUCTURES */
+
+#define Dynarr_length(d) (Dynarr_verify (d)->cur)
+#define Dynarr_largest(d) (Dynarr_verify (d)->largest)
+#define Dynarr_reset(d) (Dynarr_verify_mod (d)->cur = 0)
+#define Dynarr_add_many(d, el, len) Dynarr_insert_many (d, el, len, (d)->cur)
+#define Dynarr_insert_many_at_start(d, el, len) \
+ Dynarr_insert_many (d, el, len, 0)
+#define Dynarr_add_literal_string(d, s) Dynarr_add_many (d, s, sizeof (s) - 1)
+#define Dynarr_add_lisp_string(d, s, codesys) \
+do { \
+ Lisp_Object dyna_ls_s = (s); \
+ Lisp_Object dyna_ls_cs = (codesys); \
+ Extbyte *dyna_ls_eb; \
+ Bytecount dyna_ls_bc; \
+ \
+ LISP_STRING_TO_SIZED_EXTERNAL (dyna_ls_s, dyna_ls_eb, \
+ dyna_ls_bc, dyna_ls_cs); \
+ Dynarr_add_many (d, dyna_ls_eb, dyna_ls_bc); \
+} while (0)
+
+#if 1
+#define Dynarr_add(d, el) \
+do { \
+ if (Dynarr_verify_mod (d)->cur >= (d)->max) \
+ Dynarr_resize ((d), (d)->cur+1); \
+ ((d)->base)[(d)->cur] = (el); \
+ \
+ if ((d)->lisp_imp) \
+ set_lheader_implementation \
+ ((struct lrecord_header *)&(((d)->base)[(d)->cur]), \
+ (d)->lisp_imp); \
+ \
+ (d)->cur++; \
+ if ((d)->cur > (d)->largest) \
+ (d)->largest = (d)->cur; \
+} while (0)
+#else
+#define Dynarr_add(d, el) ( \
+ Dynarr_verify_mod (d)->cur >= (d)->max ? Dynarr_resize ((d), (d)->cur+1) : \
+ (void) 0, \
+ ((d)->base)[(d)->cur++] = (el), \
+ (d)->cur > (d)->largest ? (d)->largest = (d)->cur : (int) 0)
+#endif
+
+
+/* The following defines will get you into real trouble if you aren't
+ careful. But they can save a lot of execution time when used wisely. */
+#define Dynarr_increment(d) (Dynarr_verify_mod (d)->cur++)
+#define Dynarr_set_size(d, n) (Dynarr_verify_mod (d)->cur = n)
+
+#define Dynarr_pop(d) \
+ (assert ((d)->cur > 0), Dynarr_verify_mod (d)->cur--, \
+ Dynarr_at (d, (d)->cur))
+#define Dynarr_delete(d, i) Dynarr_delete_many (d, i, 1)
+#define Dynarr_delete_by_pointer(d, p) \
+ Dynarr_delete_many (d, (p) - ((d)->base), 1)
+
+#define Dynarr_delete_object(d, el) \
+do \
+{ \
+ REGISTER int i; \
+ for (i = Dynarr_length (d) - 1; i >= 0; i--) \
+ { \
+ if (el == Dynarr_at (d, i)) \
+ Dynarr_delete_many (d, i, 1); \
+ } \
+} while (0)
+
+#ifdef MEMORY_USAGE_STATS
+struct overhead_stats;
+Bytecount Dynarr_memory_usage (void *d, struct overhead_stats *stats);
+#endif
+
+void *stack_like_malloc (Bytecount size);
+void stack_like_free (void *val);
+
+/* ------------------------------- */
+/* Dynarr typedefs */
+/* ------------------------------- */
+
+/* Dynarr typedefs -- basic types first */
+
+typedef struct
+{
+ Dynarr_declare (Ibyte);
+} Ibyte_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (Extbyte);
+} Extbyte_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (Ichar);
+} Ichar_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (char);
+} char_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (char *);
+} char_ptr_dynarr;
+
+typedef unsigned char unsigned_char;
+typedef struct
+{
+ Dynarr_declare (unsigned char);
+} unsigned_char_dynarr;
+
+typedef unsigned long unsigned_long;
+typedef struct
+{
+ Dynarr_declare (unsigned long);
+} unsigned_long_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (int);
+} int_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (Charbpos);
+} Charbpos_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (Bytebpos);
+} Bytebpos_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (Charcount);
+} Charcount_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (Bytecount);
+} Bytecount_dynarr;
+
+/* Dynarr typedefs -- more complex types */
+
+typedef struct
+{
+ Dynarr_declare (struct face_cachel);
+} face_cachel_dynarr;
+
+DECLARE_LRECORD (face_cachel_dynarr, face_cachel_dynarr);
+#define XFACE_CACHEL_DYNARR(x) \
+ XRECORD (x, face_cachel_dynarr, face_cachel_dynarr)
+#define wrap_face_cachel_dynarr(p) wrap_record (p, face_cachel_dynarr)
+#define FACE_CACHEL_DYNARRP(x) RECORDP (x, face_cachel_dynarr)
+#define CHECK_FACE_CACHEL_DYNARR(x) CHECK_RECORD (x, face_cachel_dynarr)
+#define CONCHECK_FACE_CACHEL_DYNARR(x) CONCHECK_RECORD (x, face_cachel_dynarr)
+
+typedef struct
+{
+ Dynarr_declare (struct glyph_cachel);
+} glyph_cachel_dynarr;
+
+DECLARE_LRECORD (glyph_cachel_dynarr, glyph_cachel_dynarr);
+#define XGLYPH_CACHEL_DYNARR(x) \
+ XRECORD (x, glyph_cachel_dynarr, glyph_cachel_dynarr)
+#define wrap_glyph_cachel_dynarr(p) wrap_record (p, glyph_cachel_dynarr)
+#define GLYPH_CACHEL_DYNARRP(x) RECORDP (x, glyph_cachel_dynarr)
+#define CHECK_GLYPH_CACHEL_DYNARR(x) CHECK_RECORD (x, glyph_cachel_dynarr)
+#define CONCHECK_GLYPH_CACHEL_DYNARR(x) \
+ CONCHECK_RECORD (x, glyph_cachel_dynarr)
+
+typedef struct
+{
+ Dynarr_declare (struct console_type_entry);
+} console_type_entry_dynarr;
+
+/* WARNING WARNING WARNING. You must ensure on your own that proper
+ GC protection is provided for the elements in this array. */
+typedef struct
+{
+ Dynarr_declare (Lisp_Object);
+} Lisp_Object_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (Lisp_Object *);
+} Lisp_Object_ptr_dynarr;
+#endif /* NEW_GC */
+
/*------------------------------ unbound -------------------------------*/
/* Qunbound is a special Lisp_Object (actually of type
＠＠ -2282,6 +2566,67 ＠＠ TRUE_LIST_P (Lisp_Object object)
/*------------------------------ string --------------------------------*/
+#ifdef NEW_GC
+struct Lisp_String_Direct_Data
+{
+ struct lrecord_header header;
+ Bytecount size;
+ Ibyte data[1];
+};
+typedef struct Lisp_String_Direct_Data Lisp_String_Direct_Data;
+
+DECLARE_MODULE_API_LRECORD (string_direct_data, Lisp_String_Direct_Data);
+#define XSTRING_DIRECT_DATA(x) \
+ XRECORD (x, string_direct_data, Lisp_String_Direct_Data)
+#define wrap_string_direct_data(p) wrap_record (p, string_direct_data)
+#define STRING_DIRECT_DATAP(x) RECORDP (x, string_direct_data)
+#define CHECK_STRING_DIRECT_DATA(x) CHECK_RECORD (x, string_direct_data)
+#define CONCHECK_STRING_DIRECT_DATA(x) CONCHECK_RECORD (x, string_direct_data)
+
+#define XSTRING_DIRECT_DATA_SIZE(x) XSTRING_DIRECT_DATA (x)->size
+#define XSTRING_DIRECT_DATA_DATA(x) XSTRING_DIRECT_DATA (x)->data
+
+
+struct Lisp_String_Indirect_Data
+{
+ struct lrecord_header header;
+ Bytecount size;
+ Ibyte *data;
+};
+typedef struct Lisp_String_Indirect_Data Lisp_String_Indirect_Data;
+
+DECLARE_MODULE_API_LRECORD (string_indirect_data, Lisp_String_Indirect_Data);
+#define XSTRING_INDIRECT_DATA(x) \
+ XRECORD (x, string_indirect_data, Lisp_String_Indirect_Data)
+#define wrap_string_indirect_data(p) wrap_record (p, string_indirect_data)
+#define STRING_INDIRECT_DATAP(x) RECORDP (x, string_indirect_data)
+#define CHECK_STRING_INDIRECT_DATA(x) CHECK_RECORD (x, string_indirect_data)
+#define CONCHECK_STRING_INDIRECT_DATA(x) \
+ CONCHECK_RECORD (x, string_indirect_data)
+
+#define XSTRING_INDIRECT_DATA_SIZE(x) XSTRING_INDIRECT_DATA (x)->size
+#define XSTRING_INDIRECT_DATA_DATA(x) XSTRING_INDIRECT_DATA (x)->data
+
+
+#define XSTRING_DATA_SIZE(s) ((s)->indirect)? \
+ XSTRING_INDIRECT_DATA_SIZE ((s)->data_object): \
+ XSTRING_DIRECT_DATA_SIZE ((s)->data_object)
+#define XSTRING_DATA_DATA(s) ((s)->indirect)? \
+ XSTRING_INDIRECT_DATA_DATA ((s)->data_object): \
+ XSTRING_DIRECT_DATA_DATA ((s)->data_object)
+
+#define XSET_STRING_DATA_SIZE(s, len) \
+ if ((s)->indirect) \
+ XSTRING_INDIRECT_DATA_SIZE ((s)->data_object) = len; \
+ else \
+ XSTRING_DIRECT_DATA_SIZE ((s)->data_object) = len
+#define XSET_STRING_DATA_DATA(s, ptr) \
+ if ((s)->indirect) \
+ XSTRING_INDIRECT_DATA_DATA ((s)->data_object) = ptr; \
+ else \
+ XSTRING_DIRECT_DATA_DATA ((s)->data_object) = ptr
+#endif /* NEW_GC */
+
struct Lisp_String
{
union
＠＠ -2308,8 +2653,13 ＠＠ struct Lisp_String
#endif /* not MC_ALLOC */
} v;
} u;
+#ifdef NEW_GC
+ int indirect;
+ Lisp_Object data_object;
+#else /* not NEW_GC */
Bytecount size_;
Ibyte *data_;
+#endif /* not NEW_GC */
Lisp_Object plist;
};
typedef struct Lisp_String Lisp_String;
＠＠ -2332,14 +2682,30 ＠＠ DECLARE_MODULE_API_LRECORD (string, Lisp
stuff there. */
/* Operations on Lisp_String *'s; only ones left */
+#ifdef NEW_GC
+#define set_lispstringp_indirect(s) ((s)->indirect = 1)
+#define set_lispstringp_length(s, len) XSET_STRING_DATA_SIZE (s, len)
+#define set_lispstringp_data(s, ptr) XSET_STRING_DATA_DATA (s, ptr)
+#else /* not NEW_GC */
#define set_lispstringp_length(s, len) ((void) ((s)->size_ = (len)))
#define set_lispstringp_data(s, ptr) ((void) ((s)->data_ = (ptr)))
+#endif /* not NEW_GC */
/* Operations on strings as Lisp_Objects. Don't manipulate Lisp_String *'s
in any new code. */
+#ifdef NEW_GC
+#define STRING_DATA_OBJECT(s) ((s)->data_object)
+#define XSTRING_DATA_OBJECT(s) (STRING_DATA_OBJECT (XSTRING (s)))
+#define XSTRING_LENGTH(s) (XSTRING_DATA_SIZE (XSTRING (s)))
+#else /* not NEW_GC */
#define XSTRING_LENGTH(s) (XSTRING (s)->size_)
+#endif /* not NEW_GC */
#define XSTRING_PLIST(s) (XSTRING (s)->plist)
+#ifdef NEW_GC
+#define XSTRING_DATA(s) (XSTRING_DATA_DATA (XSTRING (s)))
+#else /* not NEW_GC */
#define XSTRING_DATA(s) (XSTRING (s)->data_ + 0)
+#endif /* not NEW_GC */
#define XSTRING_ASCII_BEGIN(s) (XSTRING (s)->u.v.ascii_begin + 0)
#define XSET_STRING_LENGTH(s, ptr) set_lispstringp_length (XSTRING (s), ptr)
#define XSET_STRING_DATA(s, ptr) set_lispstringp_data (XSTRING (s), ptr)
＠＠ -3624,7 +3990,7 ＠＠ do \
} while (0)
extern Lisp_Object_ptr_dynarr *staticpros;
-
+extern Lisp_Object_ptr_dynarr *staticpros_nodump;
#ifdef DEBUG_XEMACS
/* Help debug crashes gc-marking a staticpro'ed object. */
＠＠ -3734,7 +4100,9 ＠＠ MODULE_API Lisp_Object vector3 (Lisp_Obj
Lisp_Object make_bit_vector (Elemcount, Lisp_Object);
Lisp_Object make_bit_vector_from_byte_vector (unsigned char *, Elemcount);
Lisp_Object noseeum_make_marker (void);
+#ifndef NEW_GC
void garbage_collect_1 (void);
+#endif /* not NEW_GC */
MODULE_API Lisp_Object acons (Lisp_Object, Lisp_Object, Lisp_Object);
MODULE_API Lisp_Object cons3 (Lisp_Object, Lisp_Object, Lisp_Object);
MODULE_API Lisp_Object list1 (Lisp_Object);
＠＠ -3749,7 +4117,9 ＠＠ MODULE_API Lisp_Object list6 (Lisp_Objec
DECLARE_DOESNT_RETURN (memory_full (void));
void disksave_object_finalization (void);
extern int purify_flag;
+#ifndef NEW_GC
extern EMACS_INT gc_generation_number[1];
+#endif /* not NEW_GC */
int c_readonly (Lisp_Object);
int lisp_readonly (Lisp_Object);
MODULE_API void copy_lisp_object (Lisp_Object dst, Lisp_Object src);
＠＠ -3770,6 +4140,7 ＠＠ void free_alist (Lisp_Object);
void free_marker (Lisp_Object);
int object_dead_p (Lisp_Object);
void mark_object (Lisp_Object obj);
+#ifndef NEW_GC
#ifdef USE_KKCC
#ifdef DEBUG_XEMACS
void kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos);
＠＠ -3783,6 +4154,7 ＠＠ void kkcc_gc_stack_push_lisp_object_1 (L
#define kkcc_backtrace()
#endif
#endif /* USE_KKCC */
+#endif /* not NEW_GC */
int marked_p (Lisp_Object obj);
extern int funcall_allocation_flag;
extern int need_to_garbage_collect;
1.44 +139 -67 XEmacs/xemacs/src/lrecord.h
Index: lrecord.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lrecord.h,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -p -r1.43 -r1.44
--- lrecord.h 2005/11/13 10:48:03 1.43
+++ lrecord.h 2005/11/25 01:42:05 1.44
＠＠ -1,3 +1,5 ＠＠
+#define NEW_GC_REMOVE
+
/* The "lrecord" structure (header of a compound lisp object).
Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
Copyright (C) 1996, 2001, 2002, 2004, 2005 Ben Wing.
＠＠ -217,38 +219,38 ＠＠ enum lrecord_type
#### 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_varalias,
+ lrecord_type_symbol_value_lisp_magic,
+ lrecord_type_symbol_value_buffer_local,
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, /* 7 */
- lrecord_type_string, /* 8 */
+ lrecord_type_symbol,
+ lrecord_type_subr,
+ lrecord_type_cons,
+ lrecord_type_vector,
+ lrecord_type_string,
#ifndef MC_ALLOC
lrecord_type_lcrecord_list,
#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 */
+ 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 /* not defined */
lrecord_type_key_data,
lrecord_type_button_data,
＠＠ -260,47 +262,79 ＠＠ enum lrecord_type
lrecord_type_magic_eval_data,
lrecord_type_magic_data,
#endif /* EVENT_DATA_AS_OBJECTS */
- 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 */
+ 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,
#ifndef MC_ALLOC
lrecord_type_free, /* only used for "free" lrecords */
lrecord_type_undefined, /* only used for debugging */
#endif /* not MC_ALLOC */
- lrecord_type_last_built_in_type /* 65 */ /* must be last */
+#ifdef NEW_GC
+ lrecord_type_string_indirect_data,
+ lrecord_type_string_direct_data,
+ lrecord_type_hash_table_entry,
+ lrecord_type_syntax_cache,
+ lrecord_type_buffer_text,
+ lrecord_type_compiled_function_args,
+ lrecord_type_tty_console,
+ lrecord_type_stream_console,
+ lrecord_type_dynarr,
+ lrecord_type_face_cachel,
+ lrecord_type_face_cachel_dynarr,
+ lrecord_type_glyph_cachel,
+ lrecord_type_glyph_cachel_dynarr,
+ lrecord_type_x_device,
+ lrecord_type_gtk_device,
+ lrecord_type_tty_device,
+ lrecord_type_mswindows_device,
+ lrecord_type_msprinter_device,
+ lrecord_type_x_frame,
+ lrecord_type_gtk_frame,
+ lrecord_type_mswindows_frame,
+ lrecord_type_gap_array_marker,
+ lrecord_type_gap_array,
+ lrecord_type_extent_list_marker,
+ lrecord_type_extent_list,
+ lrecord_type_stack_of_extents,
+ lrecord_type_tty_color_instance_data,
+ lrecord_type_tty_font_instance_data,
+ lrecord_type_specifier_caching,
+ lrecord_type_expose_ignore,
+#endif /* NEW_GC */
+ lrecord_type_last_built_in_type /* must be last */
};
extern MODULE_API int lrecord_type_count;
＠＠ -400,6 +434,12 ＠＠ lrecord_implementations_table[lrecord_ty
LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj))
#define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type]
+#include "gc.h"
+
+#ifdef NEW_GC
+#include "vdb.h"
+#endif /* NEW_GC */
+
extern int gc_in_progress;
#ifdef MC_ALLOC
＠＠ -407,14 +447,31 ＠＠ extern int gc_in_progress;
#ifdef ALLOC_TYPE_STATS
void init_lrecord_stats (void);
-void inc_lrecord_string_data_stats (Bytecount size);
-void dec_lrecord_string_data_stats (Bytecount size);
void inc_lrecord_stats (Bytecount size, const struct lrecord_header *h);
void dec_lrecord_stats (Bytecount size_including_overhead,
const struct lrecord_header *h);
+int lrecord_stats_heap_size (void);
#endif /* ALLOC_TYPE_STATS */
/* Tell mc-alloc how to call a finalizer. */
+#ifdef NEW_GC
+#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) \
+ { \
+ GC_STAT_FINALIZED; \
+ MCACF_implementation->finalizer (ptr, 0); \
+ } \
+ } \
+} while (0)
+#else /* not NEW_GC */
#define MC_ALLOC_CALL_FINALIZER(ptr) \
{ \
Lisp_Object MCACF_obj = wrap_pointer_1 (ptr); \
＠＠ -428,6 +485,7 ＠＠ void dec_lrecord_stats (Bytecount size_i
MCACF_implementation->finalizer (ptr, 0); \
} \
} while (0)
+#endif /* not NEW_GC */
/* Tell mc-alloc how to call a finalizer for disksave. */
#define MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE(ptr) \
＠＠ -952,6 +1010,9 ＠＠ enum memory_description_type
{
XD_LISP_OBJECT_ARRAY,
XD_LISP_OBJECT,
+#ifdef NEW_GC
+ XD_LISP_OBJECT_BLOCK_PTR,
+#endif /* NEW_GC */
XD_LO_LINK,
XD_OPAQUE_PTR,
XD_OPAQUE_PTR_CONVERTIBLE,
＠＠ -1088,6 +1149,14 ＠＠ extern const struct sized_memory_descrip
{ XD_INT, offsetof (base_type, cur) }, \
{ XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) } \
+#ifdef NEW_GC
+#define XD_LISP_DYNARR_DESC(base_type, sub_desc) \
+ { XD_LISP_OBJECT_BLOCK_PTR, offsetof (base_type, base), \
+ XD_INDIRECT(1, 0), {sub_desc} }, \
+ { XD_INT, offsetof (base_type, cur) }, \
+ { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) }
+#endif /* not NEW_GC */
+
/* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size.
DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies.
*/
＠＠ -1673,6 +1742,9 ＠＠ void old_free_lcrecord (Lisp_Object rec)
void *alloc_lrecord (Bytecount size,
const struct lrecord_implementation *);
+
+void *alloc_lrecord_array (Bytecount size, int elemcount,
+ const struct lrecord_implementation *);
#define alloc_lrecord_type(type, lrecord_implementation) \
((type *) alloc_lrecord (sizeof (type), lrecord_implementation))
1.6 +539 -309 XEmacs/xemacs/src/mc-alloc.c
Index: mc-alloc.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/mc-alloc.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -p -r1.5 -r1.6
--- mc-alloc.c 2005/10/14 01:22:01 1.5
+++ mc-alloc.c 2005/11/25 01:42:05 1.6
＠＠ -21,17 +21,43 ＠＠ Boston, MA 02111-1307, USA. */
/* Synched up with: Not in FSF. */
#include <config.h>
+
#include "lisp.h"
#include "mc-alloc.h"
+#include "getpagesize.h"
-/*--- configurable values ----------------------------------------------*/
+#if 0
+# define USE_MARK_BITS_FREE_LIST 1
+#endif
+#if 1
+# define BLOCKTYPE_ALLOC_PAGE_HEADER 1
+#endif
-/* Valid page sizes are powers of 2. */
-#undef PAGE_SIZE /* for FreeBSD */
-#define PAGE_SIZE 2048
+/* Memory protection needs the real system-dependent pagesize. */
+#ifndef WIN32_NATIVE
+#include <unistd.h> /* for getpagesize () */
+#endif
+#if defined (HAVE_GETPAGESIZE)
+# define SYS_PAGE_SIZE getpagesize ()
+#elif defined (_SC_PAGESIZE)
+# define SYS_PAGE_SIZE sysconf (_SC_PAGESIZE)
+#elif defined (_SC_PAGE_SIZE)
+# define SYS_PAGE_SIZE sysconf (_SC_PAGE_SIZE)
+#elif defined(get_page_size)
+# define SYS_PAGE_SIZE get_page_size ()
+#elif defined(PAGESIZE)
+# define SYS_PAGE_SIZE PAGESIZE
+#elif defined(PAGE_SIZE)
+# define SYS_PAGE_SIZE PAGE_SIZE
+#else
+ /* Valid page sizes are powers of 2. */
+# define SYS_PAGE_SIZE 4096
+#endif
+/*--- configurable values ----------------------------------------------*/
+
/* Definition of size classes */
/* Heap used list constants: In the used heap, it is important to
＠＠ -41,11 +67,19 ＠＠ Boston, MA 02111-1307, USA. */
avoid wasting memory. */
/* Minimum object size in bytes. */
-#define USED_LIST_MIN_OBJECT_SIZE 8
+#if BITS_PER_EMACS_INT > 32
+# define USED_LIST_MIN_OBJECT_SIZE 16
+#else
+# define USED_LIST_MIN_OBJECT_SIZE 8
+#endif
/* The step size by which the size classes increase (up to upper
threshold). This many bytes are mapped to a single used list: */
-#define USED_LIST_LIN_STEP 4
+#if BITS_PER_EMACS_INT > 32
+# define USED_LIST_LIN_STEP 8
+#else
+# define USED_LIST_LIN_STEP 4
+#endif
/* 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
＠＠ -53,26 +87,7 ＠＠ Boston, MA 02111-1307, USA. */
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 step size by which the size classes increase (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
+#define USED_LIST_UPPER_THRESHOLD PAGE_SIZE_DIV_2
/* Heap free list constants: In the unused heap, the size of
＠＠ -93,6 +108,18 ＠＠ Boston, MA 02111-1307, USA. */
#define FREE_LIST_UPPER_THRESHOLD 256
+/* used heap list count */
+#define N_USED_PAGE_LISTS (((USED_LIST_UPPER_THRESHOLD \
+ - USED_LIST_MIN_OBJECT_SIZE) \
+ / USED_LIST_LIN_STEP) + 1 ) + 1
+
+/* 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)
+
+
/* Maximum number of separately added heap sections. */
#if BITS_PER_EMACS_INT > 32
# define MAX_HEAP_SECTS 2048
＠＠ -103,7 +130,7 ＠＠ Boston, MA 02111-1307, USA. */
/* Heap growth constants. Heap increases by any number between the
boundaries (unit is PAGE_SIZE). */
-#define MIN_HEAP_INCREASE 32
+#define MIN_HEAP_INCREASE 256
#define MAX_HEAP_INCREASE 256 /* not used */
/* Every heap growth is calculated like this:
＠＠ -120,96 +147,22 ＠＠ Boston, MA 02111-1307, USA. */
#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
+
+/*--- values depending on PAGE_SIZE ------------------------------------*/
-/* 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 */
+/* initialized in init_mc_allocator () */
+static EMACS_INT log_page_size;
+static EMACS_INT page_size_div_2;
-/* 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)
+#undef PAGE_SIZE
+#define PAGE_SIZE SYS_PAGE_SIZE
+#define LOG_PAGE_SIZE log_page_size
+#define PAGE_SIZE_DIV_2 page_size_div_2
/* Constants for heap address to page header mapping. */
＠＠ -237,8 +190,7 ＠＠ Boston, MA 02111-1307, USA. */
/*--- structs and typedefs ---------------------------------------------*/
-/* Links the free lists (mark_bit_free_list, page_header_free_list,
- cell free list). */
+/* Links the free lists (mark_bit_free_list and cell free list). */
typedef struct free_link
{
struct lrecord_header lheader;
＠＠ -246,7 +198,7 ＠＠ typedef struct free_link
} free_link;
-/* Header for pages. They are hold in a doubly linked list. */
+/* Header for pages. They are held in a doubly linked list. */
typedef struct page_header
{
struct page_header *next; /* next page_header */
＠＠ -263,7 +215,11 ＠＠ typedef struct page_header
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 */
+ unsigned int black_bit:1; /* objects on page are black */
+ unsigned int dirty_bit:1; /* page is dirty */
+ unsigned int protection_bit:1; /* page is write protected */
+ unsigned int array_bit:1; /* page holds arrays */
+ Rawbyte *mark_bits; /* pointer to mark bits */
void *heap_space; /* pointer to heap, where objects
are stored */
} page_header;
＠＠ -272,7 +228,6 ＠＠ typedef struct page_header
/* Different list types. */
enum list_type_enum {
USED_LIST,
- UNMANAGED_LIST,
FREE_LIST
};
＠＠ -339,20 +294,19 ＠＠ typedef struct mc_allocator_globals_type
/* 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];
+ page_list_header *used_heap_pages;
/* 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];
+ level_2_lookup_tree **ptr_lookup_table;
+#ifndef BLOCKTYPE_ALLOC_PAGE_HEADER
/* page header free list */
free_link *page_header_free_list;
+#endif /* not BLOCKTYPE_ALLOC_PAGE_HEADER */
#ifdef MEMORY_USAGE_STATS
EMACS_INT malloced_bytes;
＠＠ -369,9 +323,6 ＠＠ mc_allocator_globals_type mc_allocator_g
#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])
＠＠ -398,6 +349,10 ＠＠ mc_allocator_globals_type mc_allocator_g
# 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_BLACK_BIT(ph) PH (ph)->black_bit
+# define PH_DIRTY_BIT(ph) PH (ph)->dirty_bit
+# define PH_PROTECTION_BIT(ph) PH (ph)->protection_bit
+# define PH_ARRAY_BIT(ph) PH (ph)->array_bit
# 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))
＠＠ -412,7 +367,9 ＠＠ mc_allocator_globals_type mc_allocator_g
#define HEAP_SECTION(index) mc_allocator_globals.heap_sections[index]
#define N_HEAP_SECTIONS mc_allocator_globals.n_heap_sections
+#ifndef BLOCKTYPE_ALLOC_PAGE_HEADER
#define PAGE_HEADER_FREE_LIST mc_allocator_globals.page_header_free_list
+#endif /* not BLOCKTYPE_ALLOC_PAGE_HEADER */
#define NEXT_FREE(free_list) ((free_link*) free_list)->next_free
#define FREE_LIST(free_list) (free_link*) (free_list)
＠＠ -444,9 +401,13 ＠＠ mc_allocator_globals_type mc_allocator_g
#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))
+/* Number of mark bits: minimum 1, maximum 8. */
+#ifdef NEW_GC
+#define N_MARK_BITS 2
+#else /* not NEW_GC */
+#define N_MARK_BITS 1
+#endif /* not NEW_GC */
＠＠ -455,12 +416,6 ＠＠ mc_allocator_globals_type mc_allocator_g
/************************************************************************/
-/* ###TODO### */
-#if 1
-# define ALLOC_MB_UNMANAGED 1
-#endif
-
-
/*--- misc functions ---------------------------------------------------*/
/* moved here from alloc.c */
＠＠ -483,7 +438,7 ＠＠ deadbeef_memory (void *ptr, Bytecount si
static void
visit_all_used_page_headers (void (*f) (page_header *ph))
{
- int i;
+ EMACS_INT i;
for (i = 0; i < N_USED_PAGE_LISTS; i++)
if (PLH_FIRST (USED_HEAP_PAGES (i)))
{
＠＠ -507,7 +462,7 ＠＠ visit_all_used_page_headers (void (*f) (
static void
set_lookup_table (void *ptr, page_header *ph)
{
- int l1_index = L1_INDEX (ptr);
+ EMACS_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))
＠＠ -537,7 +492,7 ＠＠ set_lookup_table (void *ptr, page_header
static void
unset_lookup_table (void *ptr)
{
- int l1_index = L1_INDEX (ptr);
+ EMACS_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))
＠＠ -554,7 +509,7 ＠＠ unset_lookup_table (void *ptr)
static page_header *
get_page_header_internal (void *ptr)
{
- int l1_index = L1_INDEX (ptr);
+ EMACS_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))
＠＠ -569,7 +524,7 ＠＠ get_page_header_internal (void *ptr)
static page_header *
get_page_header (void *ptr)
{
- int l1_index = L1_INDEX (ptr);
+ EMACS_INT l1_index = L1_INDEX (ptr);
level_2_lookup_tree *l2 = PTR_LOOKUP_TABLE (l1_index);
assert (l2);
#ifdef USE_HASH_TABLE
＠＠ -580,14 +535,14 ＠＠ get_page_header (void *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);
+ return (((EMACS_INT) ptr - (EMACS_INT)(PH_HEAP_SPACE (ph))) / cell_size)
+ * N_MARK_BITS;
else /* only one object on page */
return 0;
}
＠＠ -597,9 +552,9 ＠＠ get_mark_bit_index (void *ptr, page_head
static void
add_pages_to_lookup_table (page_header *ph, EMACS_INT n_pages)
{
- char *p = (char*) PH_HEAP_SPACE (ph);
+ Rawbyte *p = (Rawbyte *) PH_HEAP_SPACE (ph);
EMACS_INT end_of_section = (EMACS_INT) p + (PAGE_SIZE * n_pages);
- for (p = (char*) PH_HEAP_SPACE (ph);
+ for (p = (Rawbyte *) PH_HEAP_SPACE (ph);
(EMACS_INT) p < end_of_section; p += PAGE_SIZE)
set_lookup_table (p, ph);
}
＠＠ -609,7 +564,7 ＠＠ add_pages_to_lookup_table (page_header *
static void
init_lookup_table (void)
{
- int i;
+ EMACS_INT i;
for (i = 0; i < LEVEL1_SIZE; i++)
PTR_LOOKUP_TABLE (i) = 0;
}
＠＠ -619,35 +574,32 ＠＠ init_lookup_table (void)
/*--- 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 *
+static Rawbyte *
alloc_bit_array(size_t bits)
{
-#ifdef ALLOC_MB_UNMANAGED
- size_t size = ((bits + CHAR_BIT - 1) / CHAR_BIT) * sizeof(char);
+ Rawbyte *bit_array;
+#ifdef USE_MARK_BITS_FREE_LIST
+ size_t size = ((bits + CHAR_BIT - 1) / CHAR_BIT) * sizeof (Rawbyte);
+#else /* not USE_MARK_BITS_FREE_LIST */
+ size_t size =
+ ALIGN_FOR_TYPE (((bits + CHAR_BIT - 1) / CHAR_BIT) * sizeof (Rawbyte),
+ Rawbyte *);
+#endif /* not USE_MARK_BITS_FREE_LIST */
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
+ bit_array = (Rawbyte *) xmalloc_and_zero (size);
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)
+get_bit (Rawbyte *bit_array, EMACS_INT pos)
{
#if N_MARK_BITS > 1
EMACS_INT result = 0;
＠＠ -656,8 +608,8 ＠＠ get_bit (char *bit_array, EMACS_INT pos)
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;
+ result |= ((*bit_array & (1 << ((pos + i) % CHAR_BIT))) != 0) << i;
+ return result;
#else
return (*bit_array & (1 << (pos % CHAR_BIT))) != 0;
#endif
＠＠ -666,10 +618,9 ＠＠ get_bit (char *bit_array, EMACS_INT pos)
/* Bit_Arrays bit at pos to val. */
static void
-set_bit(char *bit_array, EMACS_INT pos, EMACS_INT val)
+set_bit (Rawbyte *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;
＠＠ -689,21 +640,23 ＠＠ set_bit(char *bit_array, EMACS_INT pos,
/*--- 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 USE_PNTR_MARK_BITS(ph) \
+ ((PH_CELLS_ON_PAGE (ph) * N_MARK_BITS) > BITS_PER_EMACS_INT)
+#define USE_WORD_MARK_BITS(ph) \
+ ((PH_CELLS_ON_PAGE (ph) * N_MARK_BITS) <= BITS_PER_EMACS_INT)
-#define GET_BIT_WORD(b, p) get_bit ((char*) &b, p)
+#define GET_BIT_WORD(b, p) get_bit ((Rawbyte *) &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_WORD(b, p, v) set_bit ((Rawbyte *) &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)); \
+#define ZERO_MARK_BITS_PNTR(ph) \
+do { \
+ memset (PH_MARK_BITS (ph), '\0', \
+ ((PH_CELLS_ON_PAGE (ph) * N_MARK_BITS) \
+ + CHAR_BIT - 1) / CHAR_BIT * sizeof (Rawbyte)); \
} while (0)
#define GET_BIT(bit, ph, p) \
＠＠ -733,17 +686,21 ＠＠ do { \
/* Allocates mark-bit space either from a free list or from the OS
for the given page header. */
-static char *
+static Rawbyte *
alloc_mark_bits (page_header *ph)
{
- char *result;
+ Rawbyte *result;
+#ifdef USE_MARK_BITS_FREE_LIST
if (PH_MARK_BIT_FREE_LIST (ph) == 0)
- result = (char*) alloc_bit_array (PH_CELLS_ON_PAGE (ph) * N_MARK_BITS);
+ result = (Rawbyte *) alloc_bit_array (PH_CELLS_ON_PAGE (ph) * N_MARK_BITS);
else
{
- result = (char*) PH_MARK_BIT_FREE_LIST (ph);
+ result = (Rawbyte *) PH_MARK_BIT_FREE_LIST (ph);
PH_MARK_BIT_FREE_LIST (ph) = NEXT_FREE (result);
}
+#else /* not USE_MARK_BITS_FREE_LIST */
+ result = (Rawbyte *) alloc_bit_array (PH_CELLS_ON_PAGE (ph) * N_MARK_BITS);
+#endif /* not USE_MARK_BITS_FREE_LIST */
return result;
}
＠＠ -752,15 +709,13 ＠＠ alloc_mark_bits (page_header *ph)
static void
free_mark_bits (page_header *ph)
{
-#ifdef ALLOC_MB_UNMANAGED
+#ifdef USE_MARK_BITS_FREE_LIST
+ NEXT_FREE (PH_MARK_BITS (ph)) = PH_MARK_BIT_FREE_LIST (ph);
+ PH_MARK_BIT_FREE_LIST (ph) = FREE_LIST (PH_MARK_BITS (ph));
+#else /* not USE_MARK_BITS_FREE_LIST */
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 */
+ free (PH_MARK_BITS (ph));
+#endif /* not USE_MARK_BITS_FREE_LIST */
}
＠＠ -818,6 +773,11 ＠＠ set_mark_bit (void *ptr, EMACS_INT value
assert (ph && PH_ON_USED_LIST_P (ph));
if (ph)
{
+#ifdef NEW_GC
+ if (value == BLACK)
+ if (!PH_BLACK_BIT (ph))
+ PH_BLACK_BIT (ph) = 1;
+#endif /* NEW_GC */
SET_BIT (ph, get_mark_bit_index (ptr, ph), value);
}
}
＠＠ -827,11 +787,29 ＠＠ set_mark_bit (void *ptr, EMACS_INT value
/*--- page header functions --------------------------------------------*/
+#ifdef BLOCKTYPE_ALLOC_PAGE_HEADER
+#include "blocktype.h"
+
+struct page_header_blocktype
+{
+ Blocktype_declare (page_header);
+} *the_page_header_blocktype;
+#endif /* BLOCKTYPE_ALLOC_PAGE_HEADER */
+
/* Allocates a page header either from a free list or from the OS. */
static page_header *
alloc_page_header (void)
{
+#ifdef BLOCKTYPE_ALLOC_PAGE_HEADER
page_header *result;
+#ifdef MEMORY_USAGE_STATS
+ MC_MALLOCED_BYTES += malloced_storage_size (0, sizeof (page_header), 0);
+#endif
+ result = Blocktype_alloc (the_page_header_blocktype);
+ ZERO_PAGE_HEADER (result);
+ return result;
+#else /* not BLOCKTYPE_ALLOC_PAGE_HEADER */
+ page_header *result;
if (PAGE_HEADER_FREE_LIST == 0)
{
result =
＠＠ -839,7 +817,6 ＠＠ alloc_page_header (void)
#ifdef MEMORY_USAGE_STATS
MC_MALLOCED_BYTES += malloced_storage_size (0, sizeof (page_header), 0);
#endif
-
}
else
{
＠＠ -847,6 +824,7 ＠＠ alloc_page_header (void)
PAGE_HEADER_FREE_LIST = NEXT_FREE (result);
}
return result;
+#endif /* not BLOCKTYPE_ALLOC_PAGE_HEADER */
}
＠＠ -854,11 +832,15 ＠＠ alloc_page_header (void)
static void
free_page_header (page_header *ph)
{
+#ifdef BLOCKTYPE_ALLOC_PAGE_HEADER
+ Blocktype_free (the_page_header_blocktype, ph);
+#else /* not BLOCKTYPE_ALLOC_PAGE_HEADER */
#if ZERO_MEM
ZERO_PAGE_HEADER (ph);
#endif
NEXT_FREE (ph) = PAGE_HEADER_FREE_LIST;
PAGE_HEADER_FREE_LIST = FREE_LIST (ph);
+#endif /* not BLOCKTYPE_ALLOC_PAGE_HEADER */
}
＠＠ -940,14 +922,22 ＠＠ 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;
+ {
+ // printf ("size %d -> index %d\n", size, 0);
+ return 0;
+ }
+ if (size <= (size_t) USED_LIST_UPPER_THRESHOLD)
+ {
+ // printf ("size %d -> index %d\n", size,
+ // ((size - USED_LIST_MIN_OBJECT_SIZE - 1)
+ // / USED_LIST_LIN_STEP) + 1);
+ return ((size - USED_LIST_MIN_OBJECT_SIZE - 1)
+ / USED_LIST_LIN_STEP) + 1;
+ }
+ // printf ("size %d -> index %d\n", size, N_USED_PAGE_LISTS - 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)
＠＠ -958,32 +948,8 ＠＠ get_used_list_size_value (int used_index
}
-/* 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
+static EMACS_INT
get_free_list_index (EMACS_INT n_pages)
{
if (n_pages == 0)
＠＠ -1000,7 +966,7 ＠＠ get_free_list_index (EMACS_INT n_pages)
/* 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)
+get_free_list_size_value (EMACS_INT free_index)
{
if (free_index < FREE_LIST_LOWER_THRESHOLD)
return free_index + 1;
＠＠ -1038,8 +1004,8 ＠＠ mc_alloced_storage_size (Bytecount claim
static EMACS_INT
free_heap_section (page_header *ph)
{
- int i;
- int removed = 0;
+ EMACS_INT i;
+ EMACS_INT removed = 0;
for (i = 0; i < N_HEAP_SECTIONS; i++)
if (!removed)
{
＠＠ -1220,22 +1186,23 ＠＠ expand_heap (EMACS_INT needed_pages)
/*--- used heap functions ----------------------------------------------*/
/* Installs initial free list. */
static void
-install_cell_free_list (page_header *ph)
+install_cell_free_list (page_header *ph, EMACS_INT elemcount)
{
- char *p;
- int i;
+ Rawbyte *p;
+ EMACS_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);
+ p = (Rawbyte *) 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);
+ if (elemcount == 1)
+ NEXT_FREE (p) = FREE_LIST (p + cell_size);
set_lookup_table (p, ph);
- p += cell_size;
+ p += cell_size;
}
#ifdef ERROR_CHECK_GC
assert (!LRECORD_FREE_P (p));
＠＠ -1263,7 +1230,7 ＠＠ remove_cell_free_list (page_header *ph)
/* 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)
+ size_t size, EMACS_INT elemcount)
{
/* add to list */
add_page_header_to_plh (ph, plh);
＠＠ -1273,16 +1240,21 ＠＠ install_page_in_used_list (page_header *
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);
+ if (elemcount == 1)
+ PH_CELLS_ON_PAGE (ph) = (PAGE_SIZE * PH_N_PAGES (ph)) / PH_CELL_SIZE (ph);
+ else
+ {
+ PH_CELLS_ON_PAGE (ph) = elemcount;
+ PH_ARRAY_BIT (ph) = 1;
+ }
/* init cell count */
PH_CELLS_USED (ph) = 0;
/* install mark bits and initialize cell free list */
- if (managed)
- install_mark_bits (ph);
+ install_mark_bits (ph);
- install_cell_free_list (ph);
+ install_cell_free_list (ph, elemcount);
#ifdef MEMORY_USAGE_STATS
PLH_TOTAL_CELLS (plh) += PH_CELLS_ON_PAGE (ph);
＠＠ -1299,6 +1271,11 ＠＠ remove_page_from_used_list (page_header
{
page_list_header *plh = PH_PLH (ph);
+#ifdef NEW_GC
+ if (gc_in_progress && PH_PROTECTION_BIT (ph)) ABORT();
+ /* cleanup: remove memory protection, zero page_header bits. */
+#endif /* not NEW_GC */
+
#ifdef MEMORY_USAGE_STATS
PLH_TOTAL_CELLS (plh) -= PH_CELLS_ON_PAGE (ph);
PLH_TOTAL_SPACE (plh) -= PAGE_SIZE * PH_N_PAGES (ph);
＠＠ -1377,7 +1354,7 ＠＠ static page_header *
allocate_page_from_free_list (EMACS_INT needed_pages)
{
page_header *ph = 0;
- int i;
+ EMACS_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)
＠＠ -1396,15 +1373,15 ＠＠ allocate_page_from_free_list (EMACS_INT
/* 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)
+allocate_new_page (page_list_header *plh, size_t size, EMACS_INT elemcount)
{
- EMACS_INT needed_pages = BYTES_TO_PAGES (size);
+ EMACS_INT needed_pages = BYTES_TO_PAGES (size * elemcount);
/* 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);
+ install_page_in_used_list (result, plh, size, elemcount);
return result;
}
＠＠ -1412,63 +1389,56 ＠＠ allocate_new_page (page_list_header *plh
/* 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)
+mc_alloc_1 (size_t size, EMACS_INT elemcount)
{
page_list_header *plh = 0;
page_header *ph = 0;
void *result = 0;
- if (managed)
- plh = USED_HEAP_PAGES (get_used_list_index (size));
- else
- plh = UNMANAGED_HEAP_PAGES (get_unmanaged_list_index (size));
+ plh = USED_HEAP_PAGES (get_used_list_index (size));
if (size == 0)
return 0;
- if (size < PAGE_SIZE_DIV_2)
+ if ((elemcount == 1) && (size < (size_t) 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);
+ ph = allocate_new_page (plh, size, elemcount);
/* 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);
+ memset (result, '\0', (size * elemcount));
+ MARK_LRECORD_AS_FREE (result);
/* bump used cells counter */
- PH_CELLS_USED (ph)++;
+ PH_CELLS_USED (ph) += elemcount;
#ifdef MEMORY_USAGE_STATS
- PLH_USED_CELLS (plh)++;
- if (managed)
- PLH_USED_SPACE (plh) += size;
- else
- PLH_USED_SPACE (plh) += PLH_SIZE (plh);
+ PLH_USED_CELLS (plh) += elemcount;
+ PLH_USED_SPACE (plh) += size * elemcount;
#endif
return result;
}
+/* Array allocation. */
void *
-mc_alloc (size_t size)
+mc_alloc_array (size_t size, EMACS_INT elemcount)
{
- return mc_alloc_1 (size, 1);
+ return mc_alloc_1 (size, elemcount);
}
void *
-mc_alloc_unmanaged (size_t size)
+mc_alloc (size_t size)
{
- return mc_alloc_1 (size, 0);
+ return mc_alloc_1 (size, 1);
}
-
/*--- sweep & free & finalize-------------------------------------------*/
＠＠ -1512,7 +1482,11 ＠＠ mark_free_list (page_header *ph)
free_link *fl = PH_FREE_LIST (ph);
while (fl)
{
+#ifdef NEW_GC
+ SET_BIT (ph, get_mark_bit_index (fl, ph), BLACK);
+#else /* not NEW_GC */
SET_BIT (ph, get_mark_bit_index (fl, ph), 1);
+#endif /* not NEW_GC */
fl = NEXT_FREE (fl);
}
}
＠＠ -1529,14 +1503,31 ＠＠ finalize_page (page_header *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;
+ unsigned int bit = 0;
mark_free_list (ph);
+#ifdef NEW_GC
+ /* ARRAY_BIT_HACK */
+ if (PH_ARRAY_BIT (ph))
+ for (mark_bit = 0; mark_bit < mark_bit_max_index; mark_bit++)
+ {
+ GET_BIT (bit, ph, mark_bit * N_MARK_BITS);
+ if (bit)
+ {
+ return;
+ }
+ }
+#endif /* NEW_GC */
+
for (mark_bit = 0; mark_bit < mark_bit_max_index; mark_bit++)
{
- GET_BIT (bit, ph, mark_bit);
- if (!bit)
+ GET_BIT (bit, ph, mark_bit * N_MARK_BITS);
+#ifdef NEW_GC
+ if (bit == WHITE)
+#else /* not NEW_GC */
+ if (bit == 0)
+#endif /* not NEW_GC */
{
EMACS_INT ptr = (heap_space + (heap_space_step * mark_bit));
MC_ALLOC_CALL_FINALIZER ((void *) ptr);
＠＠ -1559,8 +1550,6 ＠＠ finalize_page_for_disksave (page_header
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));
＠＠ -1591,23 +1580,46 ＠＠ mc_finalize_for_disksave (void)
static void
sweep_page (page_header *ph)
{
- char *heap_space = (char *) PH_HEAP_SPACE (ph);
+ Rawbyte *heap_space = (Rawbyte *) 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;
+ unsigned int bit = 0;
mark_free_list (ph);
+#ifdef NEW_GC
+ /* ARRAY_BIT_HACK */
+ if (PH_ARRAY_BIT (ph))
+ for (mark_bit = 0; mark_bit < mark_bit_max_index; mark_bit++)
+ {
+ GET_BIT (bit, ph, mark_bit * N_MARK_BITS);
+ if (bit)
+ {
+ zero_mark_bits (ph);
+ PH_BLACK_BIT (ph) = 0;
+ return;
+ }
+ }
+#endif /* NEW_GC */
+
for (mark_bit = 0; mark_bit < mark_bit_max_index; mark_bit++)
{
- GET_BIT (bit, ph, mark_bit);
- if (!bit)
+ GET_BIT (bit, ph, mark_bit * N_MARK_BITS);
+#ifdef NEW_GC
+ if (bit == WHITE)
+#else /* not NEW_GC */
+ if (bit == 0)
+#endif /* not NEW_GC */
{
+#ifdef NEW_GC
+ GC_STAT_FREED;
+#endif /* NEW_GC */
remove_cell (heap_space + (heap_space_step * mark_bit), ph);
}
}
zero_mark_bits (ph);
+ PH_BLACK_BIT (ph) = 0;
if (PH_CELLS_USED (ph) == 0)
remove_page_from_used_list (ph);
else if (PH_CELLS_USED (ph) < PH_CELLS_ON_PAGE (ph))
＠＠ -1627,9 +1639,24 ＠＠ mc_sweep (void)
void
mc_free (void *ptr)
{
- page_header *ph = get_page_header (ptr);
- assert (!PH_ON_FREE_LIST_P (ph));
+ page_header *ph;
+
+#ifdef NEW_GC
+ /* Do not allow manual freeing while a gc is running. Data is going
+ to be freed next gc cycle. */
+ if (write_barrier_enabled || gc_in_progress)
+ return;
+#endif /* NEW_GC */
+
+ ph = get_page_header (ptr);
+ assert (ph);
+ assert (PH_PLH (ph));
+ assert (PLH_LIST_TYPE (PH_PLH (ph)) != FREE_LIST);
+#ifdef NEW_GC
+ if (PH_ON_USED_LIST_P (ph))
+ SET_BIT (ph, get_mark_bit_index (ptr, ph), WHITE);
+#endif /* NEW_GC */
remove_cell (ptr, ph);
if (PH_CELLS_USED (ph) == 0)
＠＠ -1642,29 +1669,32 ＠＠ mc_free (void *ptr)
/* 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)
+mc_realloc_1 (void *ptr, size_t size, int elemcount)
{
if (ptr)
{
- if (size)
+ if (size * elemcount)
{
- void *result = mc_alloc_1 (size, managed);
+ void *result = mc_alloc_1 (size, elemcount);
size_t from_size = PH_CELL_SIZE (get_page_header (ptr));
- size_t cpy_size = size;
- if (size > from_size)
+ size_t cpy_size = size * elemcount;
+ if (cpy_size > from_size)
cpy_size = from_size;
memcpy (result, ptr, cpy_size);
- mc_free (ptr);
+#ifdef ALLOC_TYPE_STATS
+ inc_lrecord_stats (size, (struct lrecord_header *) result);
+#endif /* not ALLOC_TYPE_STATS */
+ /* mc_free (ptr); not needed, will be collected next gc */
return result;
}
else
{
- mc_free (ptr);
+ /* mc_free (ptr); not needed, will be collected next gc */
return 0;
}
}
else
- return mc_alloc_1 (size, managed);
+ return mc_alloc_1 (size, elemcount);
}
void *
＠＠ -1674,13 +1704,12 ＠＠ mc_realloc (void *ptr, size_t size)
}
void *
-mc_realloc_unmanaged (void *ptr, size_t size)
+mc_realloc_array (void *ptr, size_t size, EMACS_INT elemcount)
{
- return mc_realloc_1 (ptr, size, 0);
+ return mc_realloc_1 (ptr, size, elemcount);
}
-
/*--- initialization ---------------------------------------------------*/
＠＠ -1688,32 +1717,49 ＠＠ mc_realloc_unmanaged (void *ptr, size_t
void
init_mc_allocator (void)
{
- int i;
+ EMACS_INT i;
- memset (&mc_allocator_globals, '\0', sizeof (mc_allocator_globals_type));
+#ifdef MEMORY_USAGE_STATS
+ MC_MALLOCED_BYTES = 0;
+#endif
- for (i = 0; i < N_USED_PAGE_LISTS; i++)
+ /* init of pagesize dependent values */
+ switch (SYS_PAGE_SIZE)
{
- 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;
+ case 512: log_page_size = 9; break;
+ case 1024: log_page_size = 10; break;
+ case 2048: log_page_size = 11; break;
+ case 4096: log_page_size = 12; break;
+ case 8192: log_page_size = 13; break;
+ case 16384: log_page_size = 14; break;
+ default: ABORT ();
+ }
+
+ page_size_div_2 = (EMACS_INT) SYS_PAGE_SIZE >> 1;
+
+ mc_allocator_globals.used_heap_pages =
+ (page_list_header *) xmalloc_and_zero ((N_USED_PAGE_LISTS + 1)
+ * sizeof (page_list_header));
#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;
+ MC_MALLOCED_BYTES += (N_USED_PAGE_LISTS + 1) * sizeof (page_list_header);
#endif
- }
+
+ mc_allocator_globals.ptr_lookup_table =
+ (level_2_lookup_tree **)
+ xmalloc_and_zero ((LEVEL1_SIZE + 1) * sizeof (level_2_lookup_tree *));
+#ifdef MEMORY_USAGE_STATS
+ MC_MALLOCED_BYTES += (LEVEL1_SIZE + 1) * sizeof (level_2_lookup_tree *);
+#endif
+
+#ifdef BLOCKTYPE_ALLOC_PAGE_HEADER
+ the_page_header_blocktype = Blocktype_new (struct page_header_blocktype);
+#endif /* BLOCKTYPE_ALLOC_PAGE_HEADER */
- for (i = 0; i < N_UNMANAGED_PAGE_LISTS; i++)
+ for (i = 0; i < N_USED_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);
+ 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;
＠＠ -1743,10 +1789,12 ＠＠ init_mc_allocator (void)
#endif
}
+#ifndef BLOCKTYPE_ALLOC_PAGE_HEADER
PAGE_HEADER_FREE_LIST = 0;
+#endif /* not BLOCKTYPE_ALLOC_PAGE_HEADER */
#ifdef MEMORY_USAGE_STATS
- MC_MALLOCED_BYTES = sizeof (mc_allocator_globals);
+ MC_MALLOCED_BYTES += sizeof (mc_allocator_globals);
#endif
init_lookup_table ();
＠＠ -1765,12 +1813,11 ＠＠ Returns stats about the mc-alloc memory
{
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;
+ EMACS_INT used_size = 0;
+ EMACS_INT real_size = 0;
- int i;
+ EMACS_INT i;
for (i = 0; i < N_FREE_PAGE_LISTS; i++)
if (PLH_PAGE_COUNT (FREE_HEAP_PAGES(i)) > 0)
＠＠ -1779,17 +1826,6 ＠＠ Returns stats about the mc-alloc memory
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 =
＠＠ -1813,9 +1849,8 ＠＠ Returns stats about the mc-alloc memory
make_int (real_size));
return Fcons (make_int (PAGE_SIZE),
- list6 (heap_sects,
+ list5 (heap_sects,
Fnreverse (used_plhs),
- Fnreverse (unmanaged_plhs),
Fnreverse (free_plhs),
make_int (sizeof (mc_allocator_globals)),
make_int (MC_MALLOCED_BYTES)));
＠＠ -1829,3 +1864,198 ＠＠ syms_of_mc_alloc (void)
DEFSUBR (Fmc_alloc_memory_usage);
#endif /* MEMORY_USAGE_STATS */
}
+
+
+#ifdef NEW_GC
+/*--- incremental garbage collector ----------------------------------*/
+
+/* access dirty bit of page header */
+void
+set_dirty_bit (page_header *ph, unsigned int value)
+{
+ PH_DIRTY_BIT (ph) = value;
+}
+
+void
+set_dirty_bit_for_address (void *ptr, unsigned int value)
+{
+ set_dirty_bit (get_page_header (ptr), value);
+}
+
+unsigned int
+get_dirty_bit (page_header *ph)
+{
+ return PH_DIRTY_BIT (ph);
+}
+
+unsigned int
+get_dirty_bit_for_address (void *ptr)
+{
+ return get_dirty_bit (get_page_header (ptr));
+}
+
+
+/* access protection bit of page header */
+void
+set_protection_bit (page_header *ph, unsigned int value)
+{
+ PH_PROTECTION_BIT (ph) = value;
+}
+
+void
+set_protection_bit_for_address (void *ptr, unsigned int value)
+{
+ set_protection_bit (get_page_header (ptr), value);
+}
+
+unsigned int
+get_protection_bit (page_header *ph)
+{
+ return PH_PROTECTION_BIT (ph);
+}
+
+unsigned int
+get_protection_bit_for_address (void *ptr)
+{
+ return get_protection_bit (get_page_header (ptr));
+}
+
+
+/* Returns the start of the page of the object pointed to by ptr. */
+void *
+get_page_start (void *ptr)
+{
+ return PH_HEAP_SPACE (get_page_header (ptr));
+}
+
+/* Make PAGE_SIZE globally available. */
+EMACS_INT
+mc_get_page_size ()
+{
+ return PAGE_SIZE;
+}
+
+/* Is the fault at ptr on a protected page? */
+EMACS_INT
+fault_on_protected_page (void *ptr)
+{
+ page_header *ph = get_page_header_internal (ptr);
+ return (ph
+ && PH_HEAP_SPACE (ph)
+ && (PH_HEAP_SPACE (ph) <= ptr)
+ && ((void *) ((EMACS_INT) PH_HEAP_SPACE (ph)
+ + PH_N_PAGES (ph) * PAGE_SIZE) > ptr)
+ && (PH_PROTECTION_BIT (ph) == 1));
+}
+
+
+/* Protect the heap page of given page header ph if black objects are
+ on the page. */
+static void
+protect_heap_page (page_header *ph)
+{
+ if (PH_BLACK_BIT (ph))
+ {
+ void *heap_space = PH_HEAP_SPACE (ph);
+ EMACS_INT heap_space_size = PH_N_PAGES (ph) * PAGE_SIZE;
+ vdb_protect ((void *) heap_space, heap_space_size);
+ PH_PROTECTION_BIT (ph) = 1;
+ }
+}
+
+/* Protect all heap pages with black objects. */
+void
+protect_heap_pages (void)
+{
+ visit_all_used_page_headers (protect_heap_page);
+}
+
+
+/* Remove protection (if there) of heap page of given page header
+ ph. */
+static void
+unprotect_heap_page (page_header *ph)
+{
+ if (PH_PROTECTION_BIT (ph))
+ {
+ void *heap_space = PH_HEAP_SPACE (ph);
+ EMACS_INT heap_space_size = PH_N_PAGES (ph) * PAGE_SIZE;
+ vdb_unprotect (heap_space, heap_space_size);
+ PH_PROTECTION_BIT (ph) = 0;
+ }
+}
+
+/* Remove protection for all heap pages which are protected. */
+void
+unprotect_heap_pages (void)
+{
+ visit_all_used_page_headers (unprotect_heap_page);
+}
+
+/* Remove protection and mark page dirty. */
+void
+unprotect_page_and_mark_dirty (void *ptr)
+{
+ page_header *ph = get_page_header (ptr);
+ unprotect_heap_page (ph);
+ PH_DIRTY_BIT (ph) = 1;
+}
+
+/* Repush all objects on dirty pages onto the mark stack. */
+int
+repush_all_objects_on_page (void *ptr)
+{
+ int repushed_objects = 0;
+ page_header *ph = get_page_header (ptr);
+ Rawbyte *heap_space = (Rawbyte *) 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);
+ unsigned int bit = 0;
+ for (mark_bit = 0; mark_bit < mark_bit_max_index; mark_bit++)
+ {
+ GET_BIT (bit, ph, mark_bit * N_MARK_BITS);
+ if (bit == BLACK)
+ {
+ repushed_objects++;
+ gc_write_barrier
+ (wrap_pointer_1 ((heap_space + (heap_space_step * mark_bit))));
+ }
+ }
+ PH_BLACK_BIT (ph) = 0;
+ PH_DIRTY_BIT (ph) = 0;
+ return repushed_objects;
+}
+
+/* Mark black if object is currently grey. This first checks, if the
+ object is really allocated on the mc-heap. If it is, it can be
+ marked black; if it is not, it cannot be marked. */
+EMACS_INT
+maybe_mark_black (void *ptr)
+{
+ page_header *ph = get_page_header_internal (ptr);
+ unsigned int bit = 0;
+
+ if (ph && PH_PLH (ph) && PH_ON_USED_LIST_P (ph))
+ {
+ GET_BIT (bit, ph, get_mark_bit_index (ptr, ph));
+ if (bit == GREY)
+ {
+ if (!PH_BLACK_BIT (ph))
+ PH_BLACK_BIT (ph) = 1;
+ SET_BIT (ph, get_mark_bit_index (ptr, ph), BLACK);
+ }
+ return 1;
+ }
+ return 0;
+}
+
+/* Only for debugging --- not used anywhere in the sources. */
+EMACS_INT
+object_on_heap_p (void *ptr)
+{
+ page_header *ph = get_page_header_internal (ptr);
+ return (ph && PH_ON_USED_LIST_P (ph));
+}
+
+#endif /* NEW_GC */
1.3 +98 -32 XEmacs/xemacs/src/mc-alloc.h
Index: mc-alloc.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/mc-alloc.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -p -r1.2 -r1.3
--- mc-alloc.h 2005/10/14 01:22:01 1.2
+++ mc-alloc.h 2005/11/25 01:42:05 1.3
＠＠ -23,43 +23,87 ＠＠ Boston, MA 02111-1307, USA. */
#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 */
-
/*--- prototypes -------------------------------------------------------*/
BEGIN_C_DECLS
-/* Allocation related functions and macros: */
+/* Internal Allocator Functions: */
-/* Builds and initializes all needed datastructures of the new allocator. */
+/* Initialize the allocator. This has to be called prior to
+ requesting memory. */
void init_mc_allocator (void);
-/* Returns a pointer to a block of memory of given size on the used heap. */
+/* Allocate a block of memory of given size and return the pointer to
+ it. */
void *mc_alloc (size_t size);
-/* Frees the object pointed to by pointer. */
+/* Allocate a block of memory as an array with elemcount elements of
+ given size and return the pointer to it. Arrays contain several
+ objects that are allocated in one consecutive block of memory with
+ each element being a fully qualified object---that is, it has a
+ Lisp object header and a mark bit. Objects like hash tables and
+ dynamic arrays use this function. */
+void *mc_alloc_array (size_t size, EMACS_INT elemcount);
+
+/* Free the object pointed to by ptr and make its memory re-usable
+ again. The memory must have been returned by a previous call to
+ mc_alloc(). This can be used to free memory explicitly, outside a
+ garbage collection. */
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. */
+/* Modify the size of the memory block pointed to by ptr. Return the
+ address of the new block of given size. The content of the memory
+ block will be unchanged to the minimum of the old and new sizes: if
+ the new size is smaller, the overlaying data is cut off; if the new
+ size is bigger, the newly allocated memory will be uninitialized.*/
void *mc_realloc (void *ptr, size_t size);
+/* Modify the size of the array pointed to by ptr. Return the address
+ of the new array block with elemcount elements of given size. The
+ content of the memory block will be unchanged to the minimum of the
+ old and new sizes: if the new size is smaller, the overlaying data
+ is cut off; if the new size is bigger, the newly allocated memory
+ will be uninitialized.*/
+void *mc_realloc_array (void *ptr, size_t size, EMACS_INT elemcount);
+
/* Garbage collection related functions and macros: */
+#ifdef NEW_GC
+enum mark_bit_colors
+{
+ WHITE = 0,
+ BLACK = 1,
+ GREY = 2
+};
+
+/* 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) != WHITE)
+
+/* Marks the object pointed to by ptr (sets the mark bit to 1). */
+#define MARK(ptr) set_mark_bit (ptr, BLACK)
+
+/* Unmarks the object pointed to by ptr (sets the mark bit to 0). */
+#define UNMARK(ptr) set_mark_bit (ptr, WHITE)
+
+#define MARK_WHITE(ptr) set_mark_bit (ptr, WHITE)
+#define MARK_GREY(ptr) set_mark_bit (ptr, GREY)
+#define MARK_BLACK(ptr) set_mark_bit (ptr, BLACK)
+
+#define MARKED_WHITE_P(ptr) (get_mark_bit (ptr) == WHITE)
+#define MARKED_GREY_P(ptr) (get_mark_bit (ptr) == GREY)
+#define MARKED_BLACK_P(ptr) (get_mark_bit (ptr) == BLACK)
+#else /* not NEW_GC */
/* Set the mark bit of the object pointed to by ptr to value.*/
void set_mark_bit (void *ptr, EMACS_INT value);
＠＠ -75,8 +119,9 ＠＠ EMACS_INT get_mark_bit (void *ptr);
/* Unmarks the object pointed to by ptr (sets the mark bit to 0). */
#define UNMARK(ptr) set_mark_bit (ptr, 0)
+#endif /* not NEW_GC */
-/* The finalizer of every not marked object is called. The macro
+/* 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);
＠＠ -89,24 +134,12 ＠＠ 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
+ 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
＠＠ -115,6 +148,39 ＠＠ void *mc_realloc_unmanaged (void *ptr, s
Bytecount mc_alloced_storage_size (Bytecount claimed_size,
struct overhead_stats *stats);
#endif /* MEMORY_USAGE_STATS */
+
+
+#ifdef NEW_GC
+/* Incremental Garbage Collector / Write Barrier Support: */
+
+/* Return the PAGESIZE the allocator uses. Generally equals to the
+ system's PAGESIZE. */
+EMACS_INT mc_get_page_size (void);
+
+/* Is the fault at ptr on a protected page? */
+EMACS_INT fault_on_protected_page (void *ptr);
+
+/* Remove protection (if there) of heap page of given page header
+ ph. */
+void protect_heap_pages (void);
+
+/* Remove protection for all heap pages which are protected. */
+void unprotect_heap_pages (void);
+
+/* Remove protection and mark page dirty. */
+void unprotect_page_and_mark_dirty (void *ptr);
+
+/* Repush all objects on dirty pages onto the mark stack. Return
+ number of repushed objects. */
+int repush_all_objects_on_page (void *ptr);
+
+/* Mark black if object is currently grey. */
+EMACS_INT maybe_mark_black (void *ptr);
+
+/* Only for debugging---not used anywhere in the sources. */
+EMACS_INT object_on_heap_p (void *ptr);
+
+#endif /* NEW_GC */
END_C_DECLS
1.2 +32 -0 XEmacs/xemacs/src/objects-tty-impl.h
Index: objects-tty-impl.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-tty-impl.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- objects-tty-impl.h 2002/06/20 21:18:39 1.1
+++ objects-tty-impl.h 2005/11/25 01:42:05 1.2
＠＠ -29,9 +29,25 ＠＠ Boston, MA 02111-1307, USA. */
struct tty_color_instance_data
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
Lisp_Object symbol; /* so we don't have to constantly call Fintern() */
};
+#ifdef NEW_GC
+DECLARE_LRECORD (tty_color_instance_data, struct tty_color_instance_data);
+#define XTTY_COLOR_INSTANCE_DATA(x) \
+ XRECORD (x, tty_color_instance_data, struct tty_color_instance_data)
+#define wrap_tty_color_instance_data(p) \
+ wrap_record (p, tty_color_instance_data)
+#define TTY_COLOR_INSTANCE_DATAP(x) RECORDP (x, tty_color_instance_data)
+#define CHECK_TTY_COLOR_INSTANCE_DATA(x) \
+ CHECK_RECORD (x, tty_color_instance_data)
+#define CONCHECK_TTY_COLOR_INSTANCE_DATA(x) \
+ CONCHECK_RECORD (x, tty_color_instance_data)
+#endif /* NEW_GC */
+
#define TTY_COLOR_INSTANCE_DATA(c) \
((struct tty_color_instance_data *) (c)->data)
＠＠ -39,8 +55,24 ＠＠ struct tty_color_instance_data
struct tty_font_instance_data
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
Lisp_Object charset;
};
+
+#ifdef NEW_GC
+DECLARE_LRECORD (tty_font_instance_data, struct tty_font_instance_data);
+#define XTTY_FONT_INSTANCE_DATA(x) \
+ XRECORD (x, tty_font_instance_data, struct tty_font_instance_data)
+#define wrap_tty_font_instance_data(p) \
+ wrap_record (p, tty_font_instance_data)
+#define TTY_FONT_INSTANCE_DATAP(x) RECORDP (x, tty_font_instance_data)
+#define CHECK_TTY_FONT_INSTANCE_DATA(x) \
+ CHECK_RECORD (x, tty_font_instance_data)
+#define CONCHECK_TTY_FONT_INSTANCE_DATA(x) \
+ CONCHECK_RECORD (x, tty_font_instance_data)
+#endif /* NEW_GC */
#define TTY_FONT_INSTANCE_DATA(c) \
((struct tty_font_instance_data *) (c)->data)
1.17 +41 -0 XEmacs/xemacs/src/objects-tty.c
Index: objects-tty.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-tty.c,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -p -r1.16 -r1.17
--- objects-tty.c 2005/01/28 02:58:51 1.16
+++ objects-tty.c 2005/11/25 01:42:06 1.17
＠＠ -42,18 +42,36 ＠＠ static const struct memory_description t
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("tty-color-instance-data",
+ tty_color_instance_data,
+ 0, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ tty_color_instance_data_description_1,
+ struct tty_color_instance_data);
+#else /* not NEW_GC */
const struct sized_memory_description tty_color_instance_data_description = {
sizeof (struct tty_color_instance_data), tty_color_instance_data_description_1
};
+#endif /* not NEW_GC */
static const struct memory_description tty_font_instance_data_description_1 [] = {
{ XD_LISP_OBJECT, offsetof (struct tty_font_instance_data, charset) },
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("tty-font-instance-data",
+ tty_font_instance_data,
+ 0, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ tty_font_instance_data_description_1,
+ struct tty_font_instance_data);
+#else /* not NEW_GC */
const struct sized_memory_description tty_font_instance_data_description = {
sizeof (struct tty_font_instance_data), tty_font_instance_data_description_1
};
+#endif /* not NEW_GC */
DEFUN ("register-tty-color", Fregister_tty_color, 3, 3, 0, /*
Register COLOR as a recognized TTY color.
＠＠ -176,7 +194,12 ＠＠ tty_initialize_color_instance (Lisp_Colo
}
/* Don't allocate the data until we're sure that we will succeed. */
+#ifdef NEW_GC
+ c->data = alloc_lrecord_type (struct tty_color_instance_data,
+ &lrecord_tty_color_instance_data);
+#else /* not NEW_GC */
c->data = xnew (struct tty_color_instance_data);
+#endif /* not NEW_GC */
COLOR_INSTANCE_TTY_SYMBOL (c) = name;
return 1;
＠＠ -199,7 +222,11 ＠＠ static void
tty_finalize_color_instance (Lisp_Color_Instance *c)
{
if (c->data)
+#ifdef NEW_GC
+ mc_free (c->data);
+#else /* not NEW_GC */
xfree (c->data, void *);
+#endif /* not NEW_GC */
}
static int
＠＠ -254,7 +281,12 ＠＠ tty_initialize_font_instance (Lisp_Font_
}
/* Don't allocate the data until we're sure that we will succeed. */
+#ifdef NEW_GC
+ f->data = alloc_lrecord_type (struct tty_font_instance_data,
+ &lrecord_tty_font_instance_data);
+#else /* not NEW_GC */
f->data = xnew (struct tty_font_instance_data);
+#endif /* not NEW_GC */
FONT_INSTANCE_TTY_CHARSET (f) = charset;
#ifdef MULE
if (CHARSETP (charset))
＠＠ -287,7 +319,11 ＠＠ static void
tty_finalize_font_instance (Lisp_Font_Instance *f)
{
if (f->data)
+#ifdef NEW_GC
+ mc_free (f->data);
+#else /* not NEW_GC */
xfree (f->data, void *);
+#endif /* not NEW_GC */
}
static Lisp_Object
＠＠ -363,6 +399,11 ＠＠ tty_find_charset_font (Lisp_Object devic
void
syms_of_objects_tty (void)
{
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (tty_color_instance_data);
+ INIT_LRECORD_IMPLEMENTATION (tty_font_instance_data);
+#endif /* NEW_GC */
+
DEFSUBR (Fregister_tty_color);
DEFSUBR (Funregister_tty_color);
DEFSUBR (Ffind_tty_color);
1.30 +9 -1 XEmacs/xemacs/src/objects.c
Index: objects.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.c,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -p -r1.29 -r1.30
--- objects.c 2005/10/24 10:07:39 1.29
+++ objects.c 2005/11/25 01:42:06 1.30
＠＠ -63,7 +63,11 ＠＠ Lisp_Object Qcolor_instancep;
static const struct memory_description color_instance_data_description_1 []= {
#ifdef HAVE_TTY
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, tty_console },
+#else /* not NEW_GC */
{ XD_BLOCK_PTR, tty_console, 1, { &tty_color_instance_data_description } },
+#endif /* not NEW_GC */
#endif
{ XD_END }
};
＠＠ -272,7 +276,11 ＠＠ static Lisp_Object font_instance_truenam
static const struct memory_description font_instance_data_description_1 []= {
#ifdef HAVE_TTY
- { XD_BLOCK_PTR, tty_console, 1, { &tty_font_instance_data_description} },
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, tty_console },
+#else /* not NEW_GC */
+ { XD_BLOCK_PTR, tty_console, 1, { &tty_font_instance_data_description } },
+#endif /* not NEW_GC */
#endif
{ XD_END }
};
1.59 +15 -3 XEmacs/xemacs/src/print.c
Index: print.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/print.c,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -p -r1.58 -r1.59
--- print.c 2005/11/22 09:02:43 1.58
+++ print.c 2005/11/25 01:42:06 1.59
＠＠ -1733,6 +1733,17 ＠＠ print_internal (Lisp_Object obj, Lisp_Ob
if (STRINGP (obj))
{
+#ifdef NEW_GC
+ if (!debug_can_access_memory (XSTRING_DATA (obj),
+ XSTRING_LENGTH (obj)))
+ {
+ write_fmt_string
+ (printcharfun,
+ "#<EMACS BUG: %p (BAD STRING DATA %p)>",
+ lheader, XSTRING_DATA (obj));
+ break;
+ }
+#else /* not NEW_GC */
Lisp_String *l = (Lisp_String *) lheader;
if (!debug_can_access_memory (l->data_, l->size_))
{
＠＠ -1742,6 +1753,7 ＠＠ print_internal (Lisp_Object obj, Lisp_Ob
lheader, l->data_);
break;
}
+#endif /* not NEW_GC */
}
}
＠＠ -2219,9 +2231,9 ＠＠ debug_p4 (Lisp_Object obj)
debug_out ("#<%s addr=0x%lx uid=0x%lx>",
LHEADER_IMPLEMENTATION (header)->name,
(EMACS_INT) header,
- LHEADER_IMPLEMENTATION (header)->basic_p ?
- ((struct lrecord_header *) header)->uid :
- ((struct old_lcrecord_header *) header)->uid);
+ (EMACS_INT) (LHEADER_IMPLEMENTATION (header)->basic_p ?
+ ((struct lrecord_header *) header)->uid :
+ ((struct old_lcrecord_header *) header)->uid));
#endif /* not MC_ALLOC */
}
1.43 +25 -0 XEmacs/xemacs/src/specifier.c
Index: specifier.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.c,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -p -r1.42 -r1.43
--- specifier.c 2005/10/24 10:07:40 1.42
+++ specifier.c 2005/11/25 01:42:06 1.43
＠＠ -302,7 +302,11 ＠＠ finalize_specifier (void *header, int fo
/* don't be snafued by the disksave finalization. */
if (!for_disksave && !GHOST_SPECIFIER_P(sp) && sp->caching)
{
+#ifdef NEW_GC
+ mc_free (sp->caching);
+#else /* not NEW_GC */
xfree (sp->caching, struct specifier_caching *);
+#endif /* not NEW_GC */
sp->caching = 0;
}
}
＠＠ -382,10 +386,19 ＠＠ static const struct memory_description s
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("specifier-caching",
+ specifier_caching,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ specifier_caching_description_1,
+ struct specifier_caching);
+#else /* not NEW_GC */
static const struct sized_memory_description specifier_caching_description = {
sizeof (struct specifier_caching),
specifier_caching_description_1
};
+#endif /* not NEW_GC */
static const struct sized_memory_description specifier_extra_description_map[]
= {
＠＠ -403,8 +416,12 ＠＠ const struct memory_description specifie
{ XD_LISP_OBJECT, offsetof (Lisp_Specifier, frame_specs) },
{ XD_LISP_OBJECT, offsetof (Lisp_Specifier, window_specs) },
{ XD_LISP_OBJECT, offsetof (Lisp_Specifier, buffer_specs) },
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, offsetof (Lisp_Specifier, caching) },
+#else /* not NEW_GC */
{ XD_BLOCK_PTR, offsetof (Lisp_Specifier, caching), 1,
{ &specifier_caching_description } },
+#endif /* not NEW_GC */
{ XD_LISP_OBJECT, offsetof (Lisp_Specifier, magic_parent) },
{ XD_LISP_OBJECT, offsetof (Lisp_Specifier, fallback) },
{ XD_BLOCK_ARRAY, offsetof (Lisp_Specifier, data), 1,
＠＠ -2996,7 +3013,12 ＠＠ set_specifier_caching (Lisp_Object speci
assert (!GHOST_SPECIFIER_P (sp));
if (!sp->caching)
+#ifdef NEW_GC
+ sp->caching = alloc_lrecord_type (struct specifier_caching,
+ &lrecord_specifier_caching);
+#else /* not NEW_GC */
sp->caching = xnew_and_zero (struct specifier_caching);
+#endif /* not NEW_GC */
sp->caching->offset_into_struct_window = struct_window_offset;
sp->caching->value_changed_in_window = value_changed_in_window;
sp->caching->offset_into_struct_frame = struct_frame_offset;
＠＠ -3349,6 +3371,9 ＠＠ void
syms_of_specifier (void)
{
INIT_LRECORD_IMPLEMENTATION (specifier);
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (specifier_caching);
+#endif /* NEW_GC */
DEFSYMBOL (Qspecifierp);
1.19 +16 -0 XEmacs/xemacs/src/specifier.h
Index: specifier.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.h,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -p -r1.18 -r1.19
--- specifier.h 2005/10/24 10:07:41 1.18
+++ specifier.h 2005/11/25 01:42:06 1.19
＠＠ -423,6 +423,9 ＠＠ enum spec_add_meth
struct specifier_caching
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
int offset_into_struct_window;
void (*value_changed_in_window) (Lisp_Object specifier, struct window *w,
Lisp_Object oldval);
＠＠ -431,6 +434,19 ＠＠ struct specifier_caching
Lisp_Object oldval);
int always_recompute;
};
+
+#ifdef NEW_GC
+DECLARE_LRECORD (specifier_caching, struct specifier_caching);
+#define XSPECIFIER_CACHING(x) \
+ XRECORD (x, specifier_caching, struct specifier_caching)
+#define wrap_specifier_caching(p) \
+ wrap_record (p, specifier_caching)
+#define SPECIFIER_CACHINGP(x) RECORDP (x, specifier_caching)
+#define CHECK_SPECIFIER_CACHING(x) \
+ CHECK_RECORD (x, specifier_caching)
+#define CONCHECK_SPECIFIER_CACHING(x) \
+ CONCHECK_RECORD (x, specifier_caching)
+#endif /* NEW_GC */
/* #### get image instances out of domains! */
1.25 +21 -0 XEmacs/xemacs/src/syntax.c
Index: syntax.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/syntax.c,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -p -r1.24 -r1.25
--- syntax.c 2005/10/25 11:16:28 1.24
+++ syntax.c 2005/11/25 01:42:06 1.25
＠＠ -309,10 +309,19 ＠＠ static const struct memory_description s
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("syntax-cache", syntax_cache,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ syntax_cache_description_1,
+ Lisp_Syntax_Cache);
+#else /* not NEW_GC */
+
const struct sized_memory_description syntax_cache_description = {
sizeof (struct syntax_cache),
syntax_cache_description_1
};
+#endif /* not NEW_GC */
void
mark_buffer_syntax_cache (struct buffer *buf)
＠＠ -344,7 +353,12 ＠＠ void
init_buffer_syntax_cache (struct buffer *buf)
{
struct syntax_cache *cache;
+#ifdef NEW_GC
+ buf->syntax_cache = alloc_lrecord_type (struct syntax_cache,
+ &lrecord_syntax_cache);
+#else /* not NEW_GC */
buf->syntax_cache = xnew_and_zero (struct syntax_cache);
+#endif /* not NEW_GC */
cache = buf->syntax_cache;
cache->object = wrap_buffer (buf);
cache->buffer = buf;
＠＠ -359,7 +373,11 ＠＠ init_buffer_syntax_cache (struct buffer
void
uninit_buffer_syntax_cache (struct buffer *buf)
{
+#ifdef NEW_GC
+ mc_free (buf->syntax_cache);
+#else /* not NEW_GC */
xfree (buf->syntax_cache, struct syntax_cache *);
+#endif /* not NEW_GC */
buf->syntax_cache = 0;
}
＠＠ -2313,6 +2331,9 ＠＠ update_syntax_table (Lisp_Object table)
void
syms_of_syntax (void)
{
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (syntax_cache);
+#endif /* NEW_GC */
DEFSYMBOL (Qsyntax_table_p);
DEFSYMBOL (Qsyntax_table);
1.13 +18 -0 XEmacs/xemacs/src/syntax.h
Index: syntax.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/syntax.h,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -p -r1.12 -r1.13
--- syntax.h 2003/02/20 08:19:43 1.12
+++ syntax.h 2005/11/25 01:42:07 1.13
＠＠ -295,6 +295,9 ＠＠ extern int lookup_syntax_properties;
faster than if we did the whole calculation from scratch. */
struct syntax_cache
{
+#ifdef NEW_GC
+ struct lrecord_header header;
+#endif /* NEW_GC */
int use_code; /* Whether to use syntax_code or
syntax_table. This is set
depending on whether the
＠＠ -332,6 +335,21 ＠＠ struct syntax_cache
Charxpos prev_change; /* Position of the previous extent
change. */
};
+
+#ifdef NEW_GC
+typedef struct syntax_cache Lisp_Syntax_Cache;
+
+DECLARE_LRECORD (syntax_cache, Lisp_Syntax_Cache);
+
+#define XSYNTAX_CACHE(x) \
+ XRECORD (x, syntax_cache, Lisp_Syntax_Cache)
+#define wrap_syntax_cache(p) wrap_record (p, syntax_cache)
+#define SYNTAX_CACHE_P(x) RECORDP (x, syntax_cache)
+#define CHECK_SYNTAX_CACHE(x) CHECK_RECORD (x, syntax_cache)
+#define CONCHECK_SYNTAX_CACHE(x) CONCHECK_RECORD (x, syntax_cache)
+#endif /* NEW_GC */
+
+
extern const struct sized_memory_description syntax_cache_description;
1.90 +69 -0 XEmacs/xemacs/src/window.c
Index: window.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/window.c,v
retrieving revision 1.89
retrieving revision 1.90
diff -u -p -r1.89 -r1.90
--- window.c 2005/11/18 12:23:57 1.89
+++ window.c 2005/11/25 01:42:08 1.90
＠＠ -181,40 +181,80 ＠＠ static const struct memory_description f
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("face-cachel", face_cachel,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ face_cachel_description_1,
+ Lisp_Face_Cachel);
+#endif /* NEW_GC */
+
static const struct sized_memory_description face_cachel_description = {
sizeof (face_cachel),
face_cachel_description_1
};
static const struct memory_description face_cachel_dynarr_description_1[] = {
+#ifdef NEW_GC
+ XD_LISP_DYNARR_DESC (face_cachel_dynarr, &face_cachel_description),
+#else /* not NEW_GC */
XD_DYNARR_DESC (face_cachel_dynarr, &face_cachel_description),
+#endif /* not NEW_GC */
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("face-cachel-dynarr", face_cachel_dynarr,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ face_cachel_dynarr_description_1,
+ face_cachel_dynarr);
+#else /* not NEW_GC */
static const struct sized_memory_description face_cachel_dynarr_description = {
sizeof (face_cachel_dynarr),
face_cachel_dynarr_description_1
};
+#endif /* not NEW_GC */
static const struct memory_description glyph_cachel_description_1[] = {
{ XD_LISP_OBJECT, offsetof (glyph_cachel, glyph) },
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("glyph-cachel", glyph_cachel,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ glyph_cachel_description_1,
+ Lisp_Glyph_Cachel);
+#endif /* NEW_GC */
+
static const struct sized_memory_description glyph_cachel_description = {
sizeof (glyph_cachel),
glyph_cachel_description_1
};
static const struct memory_description glyph_cachel_dynarr_description_1[] = {
+#ifdef NEW_GC
+ XD_LISP_DYNARR_DESC (glyph_cachel_dynarr, &glyph_cachel_description),
+#else /* not NEW_GC */
XD_DYNARR_DESC (glyph_cachel_dynarr, &glyph_cachel_description),
+#endif /* not NEW_GC */
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("glyph-cachel-dynarr", glyph_cachel_dynarr,
+ 1, /*dumpable-flag*/
+ 0, 0, 0, 0, 0,
+ glyph_cachel_dynarr_description_1,
+ glyph_cachel_dynarr);
+#else /* not NEW_GC */
static const struct sized_memory_description glyph_cachel_dynarr_description = {
sizeof (glyph_cachel_dynarr),
glyph_cachel_dynarr_description_1
};
+#endif /* not NEW_GC */
static const struct memory_description line_start_cache_description_1[] = {
{ XD_END }
＠＠ -241,10 +281,15 ＠＠ static const struct memory_description w
{ XD_LISP_OBJECT_ARRAY, offsetof (struct window, slot), size },
#include "winslots.h"
+#ifdef NEW_GC
+ { XD_LISP_OBJECT, offsetof (struct window, face_cachels) },
+ { XD_LISP_OBJECT, offsetof (struct window, glyph_cachels) },
+#else /* not NEW_GC */
{ XD_BLOCK_PTR, offsetof (struct window, face_cachels),
1, { &face_cachel_dynarr_description } },
{ XD_BLOCK_PTR, offsetof (struct window, glyph_cachels),
1, { &glyph_cachel_dynarr_description } },
+#endif /* not NEW_GC */
{ XD_BLOCK_PTR, offsetof (struct window, line_start_cache),
1, { &line_start_cache_dynarr_description }, XD_FLAG_NO_KKCC },
{ XD_END }
＠＠ -362,8 +407,17 ＠＠ allocate_window (void)
INIT_DISP_VARIABLE (last_point, Fmake_marker ());
INIT_DISP_VARIABLE (last_start, Fmake_marker ());
INIT_DISP_VARIABLE (last_facechange, Qzero);
+#ifdef NEW_GC
+ p->face_cachels = Dynarr_lisp_new (face_cachel,
+ &lrecord_face_cachel_dynarr,
+ &lrecord_face_cachel);
+ p->glyph_cachels = Dynarr_lisp_new (glyph_cachel,
+ &lrecord_glyph_cachel_dynarr,
+ &lrecord_glyph_cachel);
+#else /* not NEW_GC */
p->face_cachels = Dynarr_new (face_cachel);
p->glyph_cachels = Dynarr_new (glyph_cachel);
+#endif /* not NEW_GC */
p->line_start_cache = Dynarr_new (line_start_cache);
p->subwindow_instance_cache = make_image_instance_cache_hash_table ();
＠＠ -3810,8 +3864,17 ＠＠ make_dummy_parent (Lisp_Object window)
/* Don't copy the pointers to the line start cache or the face
instances. */
p->line_start_cache = Dynarr_new (line_start_cache);
+#ifdef NEW_GC
+ p->face_cachels = Dynarr_lisp_new (face_cachel,
+ &lrecord_face_cachel_dynarr,
+ &lrecord_face_cachel);
+ p->glyph_cachels = Dynarr_lisp_new (glyph_cachel,
+ &lrecord_glyph_cachel_dynarr,
+ &lrecord_glyph_cachel);
+#else /* not NEW_GC */
p->face_cachels = Dynarr_new (face_cachel);
p->glyph_cachels = Dynarr_new (glyph_cachel);
+#endif /* not NEW_GC */
p->subwindow_instance_cache =
make_image_instance_cache_hash_table ();
＠＠ -5384,6 +5447,12 ＠＠ syms_of_window (void)
{
INIT_LRECORD_IMPLEMENTATION (window);
INIT_LRECORD_IMPLEMENTATION (window_mirror);
+#ifdef NEW_GC
+ INIT_LRECORD_IMPLEMENTATION (face_cachel);
+ INIT_LRECORD_IMPLEMENTATION (face_cachel_dynarr);
+ INIT_LRECORD_IMPLEMENTATION (glyph_cachel);
+ INIT_LRECORD_IMPLEMENTATION (glyph_cachel_dynarr);
+#endif /* NEW_GC */
DEFSYMBOL (Qwindowp);
DEFSYMBOL (Qwindow_live_p);
1.1 XEmacs/xemacs/src/.dbxrc.in
Index: .dbxrc.in
===================================================================
## -*- ksh -*-
## Copyright (C) 1998 Free Software Foundation, Inc.
## 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.
## Author: Martin Buchholz
## You can use this file to debug XEmacs using Sun WorkShop's dbx.
## Some functions defined here require a running process, but most
## don't. Considerable effort has been expended to this end.
## Since this file is called `.dbxrc', it will be read by dbx
## automatically when dbx is run in the build directory, which is where
## developers usually debug their xemacs.
## See also the comments in .gdbinit.
## See also the question of the XEmacs FAQ, titled
## "How to Debug an XEmacs problem with a debugger".
## gdb sources the ./.gdbinit in _addition_ to ~/.gdbinit.
## But dbx does _not_ source ~/.dbxrc if it found ./.dbxrc.
## So we simulate the gdb algorithm by doing it ourselves here.
#define NOT_C_CODE
#include "config.h"
if test -r $HOME/.dbxrc; then . $HOME/.dbxrc; fi
dbxenv language_mode ansic
ignore POLL
ignore IO
#ifdef VDB_POSIX
ignore SIGSEGV SIGBUS
#endif
document lbt << 'end'
Usage: lbt
Print the current Lisp stack trace.
Requires a running xemacs process.
end
function lbt {
call debug_backtrace()
}
document ldp << 'end'
Usage: ldp lisp_object
Print a Lisp Object value using the Lisp printer.
Requires a running xemacs process.
end
function ldp {
call debug_print ($1);
}
Lisp_Type_Int=-2
## A bug in dbx prevents string variables from having values beginning with `-'!!
function XEmacsInit {
function ToInt { eval "$1=\$[(int) \`alloc.c\`$1]"; }
ToInt dbg_USE_UNION_TYPE
ToInt Lisp_Type_Char
ToInt Lisp_Type_Record
ToInt dbg_valbits
ToInt dbg_gctypebits
function ToLong { eval "$1=\$[(\`alloc.c\`unsigned long) \`alloc.c\`$1]"; }
ToLong dbg_valmask
ToLong dbg_typemask
xemacs_initted=yes
}
function printvar {
for i in $*; do eval "echo $i=\$$i"; done
}
document decode_object << 'end'
Usage: decode_object lisp_object
Extract implementation information from a Lisp Object.
Defines variables $val, $type and $imp.
end
## Various dbx bugs cause ugliness in following code
function decode_object {
if test -z "$xemacs_initted"; then XEmacsInit; fi;
if test $dbg_USE_UNION_TYPE = 1; then
## Repeat after me... dbx sux, dbx sux, dbx sux...
## Allow both `pobj Qnil' and `pobj 0x82746834' to work
case $(whatis $1) in
*Lisp_Object*) obj="$[(`alloc.c`unsigned long)(($1).i)]";;
*) obj="$[(`alloc.c`unsigned long)($1)]";;
esac
else
obj="$[(`alloc.c`unsigned long)($1)]";
fi
if test $[(int)($obj & 1)] = 1; then
## It's an int
val=$[(long)(((unsigned long long)$obj) >> 1)]
type=$Lisp_Type_Int
else
type=$[(int)(((void*)$obj) & $dbg_typemask)]
if test $type = $Lisp_Type_Char; then
val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
else
## It's a record pointer
val=$[(void*)$obj]
if test "$val" = "(nil)"; then type=null_pointer; fi
fi
fi
if test $type = $Lisp_Type_Record; then
lheader="((struct lrecord_header *) $val)"
lrecord_type=$[(enum lrecord_type) $lheader->type]
imp=$[(void*)(`alloc.c`lrecord_implementations_table[$lheader->type])]
else
lheader="((struct lrecord_header *) -1)"
lrecord_type=-1
imp="0xdeadbeef"
fi
## printvar obj val type imp
}
function xint {
decode_object "$*"
print (long) ($val)
}
document xtype << 'end'
Usage: xtype lisp_object
Print the Lisp type of a lisp object.
end
function xtype {
decode_object "$*"
if test $type = $Lisp_Type_Int; then echo "int"
elif test $type = $Lisp_Type_Char; then echo "char"
elif test $type = null_pointer; then echo "null_pointer"
else
echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
fi
}
function lisp-shadows {
run -batch -vanilla -f list-load-path-shadows
}
function environment-to-run-temacs {
unset EMACSLOADPATH
export EMACSBOOTSTRAPLOADPATH=../lisp/:..
export EMACSBOOTSTRAPMODULEPATH=../modules/:..
}
document run-temacs << 'end'
Usage: run-temacs
Run temacs interactively, like xemacs.
Use this with debugging tools (like purify) that cannot deal with dumping,
or when temacs builds successfully, but xemacs does not.
end
function run-temacs {
environment-to-run-temacs
run -nd -batch -l ../lisp/loadup.el run-temacs -q ${1+"$＠"}
}
document check-xemacs << 'end'
Usage: check-xemacs
Run the test suite. Equivalent to 'make check'.
end
function check-xemacs {
run -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
}
document check-temacs << 'end'
Usage: check-temacs
Run the test suite on temacs. Equivalent to 'make check-temacs'.
Use this with debugging tools (like purify) that cannot deal with dumping,
or when temacs builds successfully, but xemacs does not.
end
function check-temacs {
run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
}
document update-elc << 'end'
Usage: update-elc
Run the core lisp byte compilation part of the build procedure.
Use when debugging temacs, not xemacs!
Use this when temacs builds successfully, but xemacs does not.
end
function update-elc {
environment-to-run-temacs
run -nd -batch -l ../lisp/update-elc.el
}
document dmp << 'end'
Usage: dmp
Run the dumping part of the build procedure.
Use when debugging temacs, not xemacs!
Use this when temacs builds successfully, but xemacs does not.
end
function dmp {
environment-to-run-temacs
run -nd -batch -l ../lisp/loadup.el dump
}
function pstruct { ## pstruct foo.c struct-name
module "$1" > /dev/null
type_ptr="((struct $2 *) $val)"
print $type_ptr
print *$type_ptr
}
document pobj << 'end'
Usage: pobj lisp_object
Print the internal C representation of a Lisp Object.
end
function pobj {
decode_object $1
if test $type = $Lisp_Type_Int; then
print -f"Integer: %d" $val
elif test $type = $Lisp_Type_Char; then
if test $[$val > 32 && $val < 128] = 1; then
print -f"Char: %c" $val
else
print -f"Char: %d" $val
fi
elif test $lrecord_type = lrecord_type_string; then
pstruct alloc.c Lisp_String
elif test $lrecord_type = lrecord_type_cons; then
pstruct alloc.c Lisp_Cons
elif test $lrecord_type = lrecord_type_symbol; then
pstruct symbols.c Lisp_Symbol
echo "Symbol name: $[(char *)($type_ptr->name->data)]"
elif test $lrecord_type = lrecord_type_vector; then
pstruct alloc.c Lisp_Vector
echo "Vector of length $[$type_ptr->size]"
elif test $lrecord_type = lrecord_type_bit_vector; then
pstruct fns.c Lisp_Bit_Vector
elif test $lrecord_type = lrecord_type_buffer; then
pstruct buffer.c buffer
elif test $lrecord_type = lrecord_type_char_table; then
pstruct chartab.c Lisp_Char_Table
elif test $lrecord_type = lrecord_type_char_table_entry; then
pstruct chartab.c Lisp_Char_Table_Entry
elif test $lrecord_type = lrecord_type_charset; then
pstruct mule-charset.c Lisp_Charset
elif test $lrecord_type = lrecord_type_coding_system; then
pstruct file-coding.c Lisp_Coding_System
elif test $lrecord_type = lrecord_type_color_instance; then
pstruct objects.c Lisp_Color_Instance
elif test $lrecord_type = lrecord_type_command_builder; then
pstruct event-stream.c command_builder
elif test $lrecord_type = lrecord_type_compiled_function; then
pstruct bytecode.c Lisp_Compiled_Function
elif test $lrecord_type = lrecord_type_console; then
pstruct console.c console
elif test $lrecord_type = lrecord_type_database; then
pstruct database.c Lisp_Database
elif test $lrecord_type = lrecord_type_device; then
pstruct device.c device
elif test $lrecord_type = lrecord_type_event; then
pstruct events.c Lisp_Event
elif test $lrecord_type = lrecord_type_extent; then
pstruct extents.c extent
elif test $lrecord_type = lrecord_type_extent_auxiliary; then
pstruct extents.c extent_auxiliary
elif test $lrecord_type = lrecord_type_extent_info; then
pstruct extents.c extent_info
elif test $lrecord_type = lrecord_type_face; then
pstruct faces.c Lisp_Face
elif test $lrecord_type = lrecord_type_float; then
pstruct floatfns.c Lisp_Float
elif test $lrecord_type = lrecord_type_font_instance; then
pstruct objects.c Lisp_Font_Instance
elif test $lrecord_type = lrecord_type_frame; then
pstruct frame.c frame
elif test $lrecord_type = lrecord_type_glyph; then
pstruct glyph.c Lisp_Glyph
elif test $lrecord_type = lrecord_type_gui_item; then
pstruct gui.c Lisp_Gui_Item
elif test $lrecord_type = lrecord_type_hash_table; then
pstruct elhash.c Lisp_Hash_Table
elif test $lrecord_type = lrecord_type_image_instance; then
pstruct glyphs.c Lisp_Image_Instance
elif test $lrecord_type = lrecord_type_keymap; then
pstruct keymap.c Lisp_Keymap
elif test $lrecord_type = lrecord_type_lcrecord_list; then
pstruct alloc.c lcrecord_list
elif test $lrecord_type = lrecord_type_ldap; then
pstruct ldap.c Lisp_LDAP
elif test $lrecord_type = lrecord_type_lstream; then
pstruct lstream.c lstream
elif test $lrecord_type = lrecord_type_marker; then
pstruct marker.c Lisp_Marker
elif test $lrecord_type = lrecord_type_opaque; then
pstruct opaque.c Lisp_Opaque
elif test $lrecord_type = lrecord_type_opaque_ptr; then
pstruct opaque.c Lisp_Opaque_Ptr
elif test $lrecord_type = lrecord_type_popup_data; then
pstruct gui-x.c popup_data
elif test $lrecord_type = lrecord_type_process; then
pstruct process.c Lisp_Process
elif test $lrecord_type = lrecord_type_range_table; then
pstruct rangetab.c Lisp_Range_Table
elif test $lrecord_type = lrecord_type_specifier; then
pstruct specifier.c Lisp_Specifier
elif test $lrecord_type = lrecord_type_subr; then
pstruct eval.c Lisp_Subr
elif test $lrecord_type = lrecord_type_symbol_value_buffer_local; then
pstruct symbols.c symbol_value_buffer_local
elif test $lrecord_type = lrecord_type_symbol_value_forward; then
pstruct symbols.c symbol_value_forward
elif test $lrecord_type = lrecord_type_symbol_value_lisp_magic; then
pstruct symbols.c symbol_value_lisp_magic
elif test $lrecord_type = lrecord_type_symbol_value_varalias; then
pstruct symbols.c symbol_value_varalias
elif test $lrecord_type = lrecord_type_timeout; then
pstruct event-stream.c Lisp_Timeout
elif test $lrecord_type = lrecord_type_toolbar_button; then
pstruct toolbar.c toolbar_button
elif test $lrecord_type = lrecord_type_tooltalk_message; then
pstruct tooltalk.c Lisp_Tooltalk_Message
elif test $lrecord_type = lrecord_type_tooltalk_pattern; then
pstruct tooltalk.c Lisp_Tooltalk_Pattern
elif test $lrecord_type = lrecord_type_weak_list; then
pstruct data.c weak_list
elif test $lrecord_type = lrecord_type_window; then
pstruct window.c window
elif test $lrecord_type = lrecord_type_window_configuration; then
pstruct window.c window_config
elif test "$type" = "null_pointer"; then
echo "Lisp Object is a null pointer!!"
else
echo "Unknown Lisp Object type"
print $1
fi
}
dbxenv suppress_startup_message 4.0
## dbxenv mt_watchpoints on
function dp_core {
print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
}
## Barf!
function print_shell {
print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)
}
## -------------------------------------------------------------
## functions to test the debugging support itself.
## If you change this file, make sure the following still work...
## -------------------------------------------------------------
function test_xtype {
function doit { echo -n "$1: "; xtype "$1"; }
test_various_objects
}
function test_pobj {
function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }
test_various_objects
}
function test_various_objects {
doit Vemacs_major_version
doit Vhelp_char
doit Qnil
doit Qunbound
doit Vobarray
doit Vall_weak_lists
doit Vxemacs_codename
}
1.1 XEmacs/xemacs/src/.gdbinit.in
Index: .gdbinit.in
===================================================================
## -*- ksh -*-
## Copyright (C) 1998 Free Software Foundation, Inc.
## 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.
## Author: Martin Buchholz
## Some useful commands for debugging emacs with gdb 4.16 or better.
##
## Since this file is called `.gdbinit', it will be read by gdb
## automatically when gdb is run in the build directory, which is where
## developers usually debug their xemacs. You can also source this
## file from your ~/.gdbinit, if you like.
##
## Configure xemacs with --debug, and compile with -g.
##
## See also the question of the XEmacs FAQ, titled
## "How to Debug an XEmacs problem with a debugger".
##
## This can be used to debug XEmacs no matter how the following are
## specified:
## USE_UNION_TYPE
## (the above all have configure equivalents)
## Some functions defined here require a running process, but most
## don't. Considerable effort has been expended to this end.
## See the dbg_ C support code in src/alloc.c that allows the functions
## defined in this file to work correctly.
#define NOT_C_CODE
#include "config.h"
set print union off
set print pretty off
#ifdef VDB_POSIX
handle SIGSEGV SIGBUS nostop noprint
#endif
set $Lisp_Type_Int = -2
define decode_object
set $obj = (unsigned long) $arg0
if $obj & 1
## It's an int
set $val = $obj >> 1
set $type = $Lisp_Type_Int
else
set $type = $obj & dbg_typemask
if $type == Lisp_Type_Char
set $val = ($obj & dbg_valmask) >> dbg_gctypebits
else
## It's a record pointer
set $val = $obj
end
end
if $type == Lisp_Type_Record
set $lheader = ((struct lrecord_header *) $val)
set $lrecord_type = ($lheader->type)
set $imp = ((struct lrecord_implementation *) lrecord_implementations_table[(int) $lrecord_type])
else
set $lrecord_type = -1
set $lheader = -1
set $imp = -1
end
end
document decode_object
Usage: decode_object lisp_object
Extract implementation information from a Lisp Object.
Defines variables $val, $type and $imp.
end
define xint
decode_object $arg0
print ((long) $val)
end
define xtype
decode_object $arg0
if $type == $Lisp_Type_Int
echo int\n
else
if $type == Lisp_Type_Char
echo char\n
else
printf "record type: %s\n", $imp->name
end
end
end
document xtype
Usage: xtype lisp_object
Print the Lisp type of a lisp object.
end
define lisp-shadows
run -batch -vanilla -f list-load-path-shadows
end
document lisp-shadows
Usage: lisp-shadows
Run xemacs to check for lisp shadows
end
define environment-to-run-temacs
unset env EMACSLOADPATH
set env EMACSBOOTSTRAPLOADPATH=../lisp/:..
set env EMACSBOOTSTRAPMODULEPATH=../modules/:..
end
define run-temacs
environment-to-run-temacs
run -nd -batch -l ../lisp/loadup.el run-temacs -q
end
document run-temacs
Usage: run-temacs
Run temacs interactively, like xemacs.
Use this with debugging tools (like purify) that cannot deal with dumping,
or when temacs builds successfully, but xemacs does not.
end
define check-xemacs
run -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
end
document check-xemacs
Usage: check-xemacs
Run the test suite. Equivalent to 'make check'.
end
define check-temacs
environment-to-run-temacs
run -nd -batch -l ../lisp/loadup.el run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
end
document check-temacs
Usage: check-temacs
Run the test suite on temacs. Equivalent to 'make check-temacs'.
Use this with debugging tools (like purify) that cannot deal with dumping,
or when temacs builds successfully, but xemacs does not.
end
define update-elc
environment-to-run-temacs
run -nd -batch -l ../lisp/update-elc.el
end
document update-elc
Usage: update-elc
Run the core lisp byte compilation part of the build procedure.
Use when debugging temacs, not xemacs!
Use this when temacs builds successfully, but xemacs does not.
end
define dmp
environment-to-run-temacs
run -nd -batch -l ../lisp/loadup.el dump
end
document dmp
Usage: dmp
Run the dumping part of the build procedure.
Use when debugging temacs, not xemacs!
Use this when temacs builds successfully, but xemacs does not.
end
define ldp
printf "%s", "Lisp => "
call debug_print($arg0)
end
document ldp
Usage: ldp lisp_object
Print a Lisp Object value using the Lisp printer.
Requires a running xemacs process.
end
define lbt
call debug_backtrace()
end
document lbt
Usage: lbt
Print the current Lisp stack trace.
Requires a running xemacs process.
end
define leval
ldp Feval(Fcar(Fread_from_string(build_string($arg0),Qnil,Qnil)))
end
document leval
Usage: leval "SEXP"
Eval a lisp expression.
Requires a running xemacs process.
Example:
(gdb) leval "(+ 1 2)"
Lisp ==> 3
end
define wtype
print $arg0->core.widget_class->core_class.class_name
end
define xtname
print XrmQuarkToString(((Object)($arg0))->object.xrm_name)
end
## GDB's command language makes you want to ...
define pptype
set $type_ptr = ($arg0 *) $val
print $type_ptr
print *$type_ptr
end
define pstructtype
set $type_ptr = (struct $arg0 *) $val
print $type_ptr
print *$type_ptr
end
define pobj
decode_object $arg0
if $type == $Lisp_Type_Int
printf "Integer: %d\n", $val
else
if $type == Lisp_Type_Char
if $val > 32 && $val < 128
printf "Char: %c\n", $val
else
printf "Char: %d\n", $val
end
else
if $lrecord_type == lrecord_type_string
pptype Lisp_String
else
if $lrecord_type == lrecord_type_cons
pptype Lisp_Cons
else
if $lrecord_type == lrecord_type_symbol
pptype Lisp_Symbol
printf "Symbol name: %s\n", ((Lisp_String *)$type_ptr->name)->data_
else
if $lrecord_type == lrecord_type_vector
pptype Lisp_Vector
printf "Vector of length %d\n", $type_ptr->size
##print *($type_ptr->data) ＠ $type_ptr->size
else
if $lrecord_type == lrecord_type_bit_vector
pptype Lisp_Bit_Vector
else
if $lrecord_type == lrecord_type_buffer
pstructtype buffer
else
if $lrecord_type == lrecord_type_char_table
pptype Lisp_Char_Table
else
if $lrecord_type == lrecord_type_char_table_entry
pptype Lisp_Char_Table_Entry
else
if $lrecord_type == lrecord_type_charset
pptype Lisp_Charset
else
if $lrecord_type == lrecord_type_coding_system
pptype Lisp_Coding_System
else
if $lrecord_type == lrecord_type_color_instance
pptype Lisp_Color_Instance
else
if $lrecord_type == lrecord_type_command_builder
pptype command_builder
else
if $lrecord_type == lrecord_type_compiled_function
pptype Lisp_Compiled_Function
else
if $lrecord_type == lrecord_type_console
pstructtype console
else
if $lrecord_type == lrecord_type_database
pptype Lisp_Database
else
if $lrecord_type == lrecord_type_device
pstructtype device
else
if $lrecord_type == lrecord_type_event
pptype Lisp_Event
else
if $lrecord_type == lrecord_type_extent
pstructtype extent
else
if $lrecord_type == lrecord_type_extent_auxiliary
pstructtype extent_auxiliary
else
if $lrecord_type == lrecord_type_extent_info
pstructtype extent_info
else
if $lrecord_type == lrecord_type_face
pptype Lisp_Face
else
if $lrecord_type == lrecord_type_float
pptype Lisp_Float
else
if $lrecord_type == lrecord_type_font_instance
pptype Lisp_Font_Instance
else
if $lrecord_type == lrecord_type_frame
pstructtype frame
else
if $lrecord_type == lrecord_type_glyph
pptype Lisp_Glyph
else
if $lrecord_type == lrecord_type_gui_item
pptype Lisp_Gui_Item
else
if $lrecord_type == lrecord_type_hash_table
pptype Lisp_Hash_Table
else
if $lrecord_type == lrecord_type_image_instance
pptype Lisp_Image_Instance
else
if $lrecord_type == lrecord_type_keymap
pptype Lisp_Keymap
else
if $lrecord_type == lrecord_type_lcrecord_list
pstructtype lcrecord_list
else
if $lrecord_type == lrecord_type_ldap
pptype Lisp_LDAP
else
if $lrecord_type == lrecord_type_lstream
pstructtype lstream
else
if $lrecord_type == lrecord_type_marker
pptype Lisp_Marker
else
if $lrecord_type == lrecord_type_opaque
pptype Lisp_Opaque
else
if $lrecord_type == lrecord_type_opaque_ptr
pptype Lisp_Opaque_Ptr
else
if $lrecord_type == lrecord_type_popup_data
pptype popup_data
else
if $lrecord_type == lrecord_type_process
pptype Lisp_Process
else
if $lrecord_type == lrecord_type_range_table
pptype Lisp_Range_Table
else
if $lrecord_type == lrecord_type_specifier
pptype Lisp_Specifier
else
if $lrecord_type == lrecord_type_subr
pptype Lisp_Subr
else
if $lrecord_type == lrecord_type_symbol_value_buffer_local
pstructtype symbol_value_buffer_local
else
if $lrecord_type == lrecord_type_symbol_value_forward
pstructtype symbol_value_forward
else
if $lrecord_type == lrecord_type_symbol_value_lisp_magic
pstructtype symbol_value_lisp_magic
else
if $lrecord_type == lrecord_type_symbol_value_varalias
pstructtype symbol_value_varalias
else
if $lrecord_type == lrecord_type_timeout
pptype Lisp_Timeout
else
if $lrecord_type == lrecord_type_toolbar_button
pstructtype toolbar_button
else
if $lrecord_type == lrecord_type_tooltalk_message
pptype Lisp_Tooltalk_Message
else
if $lrecord_type == lrecord_type_tooltalk_pattern
pptype Lisp_Tooltalk_Pattern
else
if $lrecord_type == lrecord_type_weak_list
pstructtype weak_list
else
if $lrecord_type == lrecord_type_window
pstructtype window
else
if $lrecord_type == lrecord_type_window_configuration
pstructtype window_config
else
if $lrecord_type == lrecord_type_fc_pattern
pstructtype fc_pattern
else
if $lrecord_type == lrecord_type_fc_objectset
pstructtype fc_objectset
else
if $lrecord_type == lrecord_type_fc_fontset
pstructtype fc_fontset
else
echo Unknown Lisp Object type\n
print $arg0
## Barf, gag, retch
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
## Repeat after me... gdb sux, gdb sux, gdb sux...
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
## Are we having fun yet??
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
end
document pobj
Usage: pobj lisp_object
Print the internal C representation of a Lisp Object.
end
## -------------------------------------------------------------
## functions to test the debugging support itself.
## If you change this file, make sure the following still work...
## -------------------------------------------------------------
define test_xtype
printf "Vemacs_major_version: "
xtype Vemacs_major_version
printf "Vhelp_char: "
xtype Vhelp_char
printf "Qnil: "
xtype Qnil
printf "Qunbound: "
xtype Qunbound
printf "Vobarray: "
xtype Vobarray
printf "Vall_weak_lists: "
xtype Vall_weak_lists
printf "Vxemacs_codename: "
xtype Vxemacs_codename
end
define test_pobj
printf "Vemacs_major_version: "
pobj Vemacs_major_version
printf "Vhelp_char: "
pobj Vhelp_char
printf "Qnil: "
pobj Qnil
printf "Qunbound: "
pobj Qunbound
printf "Vobarray: "
pobj Vobarray
printf "Vall_weak_lists: "
pobj Vall_weak_lists
printf "Vxemacs_codename: "
pobj Vxemacs_codename
end
1.1 XEmacs/xemacs/src/gc.c
Index: gc.c
===================================================================
/* New incremental garbage collector 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 "backtrace.h"
#include "buffer.h"
#include "bytecode.h"
#include "chartab.h"
#include "console-stream.h"
#include "device.h"
#include "elhash.h"
#include "events.h"
#include "extents-impl.h"
#include "file-coding.h"
#include "frame-impl.h"
#include "gc.h"
#include "glyphs.h"
#include "opaque.h"
#include "lrecord.h"
#include "lstream.h"
#include "process.h"
#include "profile.h"
#include "redisplay.h"
#include "specifier.h"
#include "sysfile.h"
#include "sysdep.h"
#include "window.h"
#include "vdb.h"
#define GC_CONS_THRESHOLD 2000000
#define GC_CONS_INCREMENTAL_THRESHOLD 200000
#define GC_INCREMENTAL_TRAVERSAL_THRESHOLD 100000
/* Number of bytes of consing done since the last GC. */
EMACS_INT consing_since_gc;
/* Number of bytes of consing done since startup. */
EMACS_UINT total_consing;
/* Number of bytes of current allocated heap objects. */
EMACS_INT total_gc_usage;
/* If the above is set. */
int total_gc_usage_set;
/* Number of bytes of consing since gc before another gc should be done. */
EMACS_INT gc_cons_threshold;
/* Nonzero during gc */
int gc_in_progress;
/* Percentage of consing of total data size before another GC. */
EMACS_INT gc_cons_percentage;
#ifdef NEW_GC
/* Number of bytes of consing since gc before another cycle of the gc
should be done in incremental mode. */
EMACS_INT gc_cons_incremental_threshold;
/* Number of elements marked in one cycle of incremental GC. */
EMACS_INT gc_incremental_traversal_threshold;
/* Nonzero during write barrier */
int write_barrier_enabled;
#endif /* NEW_GC */
#ifdef NEW_GC
/************************************************************************/
/* Incremental State and Statistics */
/************************************************************************/
enum gc_phase
{
NONE,
INIT_GC,
PUSH_ROOT_SET,
MARK,
REPUSH_ROOT_SET,
FINISH_MARK,
FINALIZE,
SWEEP,
FINISH_GC
};
#ifndef ERROR_CHECK_GC
struct
{
enum gc_phase phase;
} gc_state;
#else /* ERROR_CHECK_GC */
enum gc_stat_id
{
GC_STAT_TOTAL,
GC_STAT_IN_LAST_GC,
GC_STAT_IN_THIS_GC,
GC_STAT_IN_LAST_CYCLE,
GC_STAT_IN_THIS_CYCLE,
GC_STAT_COUNT /* has to be last */
};
struct
{
enum gc_phase phase;
EMACS_INT n_gc[GC_STAT_COUNT];
EMACS_INT n_cycles[GC_STAT_COUNT];
EMACS_INT enqueued[GC_STAT_COUNT];
EMACS_INT dequeued[GC_STAT_COUNT];
EMACS_INT repushed[GC_STAT_COUNT];
EMACS_INT enqueued2[GC_STAT_COUNT];
EMACS_INT dequeued2[GC_STAT_COUNT];
EMACS_INT finalized[GC_STAT_COUNT];
EMACS_INT freed[GC_STAT_COUNT];
EMACS_INT explicitly_freed;
EMACS_INT explicitly_tried_freed;
} gc_state;
#endif /* ERROR_CHECK_GC */
#define GC_PHASE gc_state.phase
#define GC_SET_PHASE(p) GC_PHASE = p
#ifdef ERROR_CHECK_GC
# define GC_STAT_START_NEW_GC gc_stat_start_new_gc ()
# define GC_STAT_RESUME_GC gc_stat_resume_gc ()
#define GC_STAT_TICK(STAT) \
gc_state.STAT[GC_STAT_TOTAL]++; \
gc_state.STAT[GC_STAT_IN_THIS_GC]++; \
gc_state.STAT[GC_STAT_IN_THIS_CYCLE]++
# define GC_STAT_ENQUEUED \
if (GC_PHASE == REPUSH_ROOT_SET) \
{ \
GC_STAT_TICK (enqueued2); \
} \
else \
{ \
GC_STAT_TICK (enqueued); \
}
# define GC_STAT_DEQUEUED \
if (gc_state.phase == REPUSH_ROOT_SET) \
{ \
GC_STAT_TICK (dequeued2); \
} \
else \
{ \
GC_STAT_TICK (dequeued); \
}
# define GC_STAT_REPUSHED GC_STAT_TICK (repushed)
#define GC_STAT_RESUME(stat) \
gc_state.stat[GC_STAT_IN_LAST_CYCLE] = \
gc_state.stat[GC_STAT_IN_THIS_CYCLE]; \
gc_state.stat[GC_STAT_IN_THIS_CYCLE] = 0
#define GC_STAT_RESTART(stat) \
gc_state.stat[GC_STAT_IN_LAST_GC] = \
gc_state.stat[GC_STAT_IN_THIS_GC]; \
gc_state.stat[GC_STAT_IN_THIS_GC] = 0; \
GC_STAT_RESUME (stat)
void
gc_stat_start_new_gc (void)
{
gc_state.n_gc[GC_STAT_TOTAL]++;
gc_state.n_cycles[GC_STAT_TOTAL]++;
gc_state.n_cycles[GC_STAT_IN_LAST_GC] = gc_state.n_cycles[GC_STAT_IN_THIS_GC];
gc_state.n_cycles[GC_STAT_IN_THIS_GC] = 1;
GC_STAT_RESTART (enqueued);
GC_STAT_RESTART (dequeued);
GC_STAT_RESTART (repushed);
GC_STAT_RESTART (finalized);
GC_STAT_RESTART (enqueued2);
GC_STAT_RESTART (dequeued2);
GC_STAT_RESTART (freed);
}
void
gc_stat_resume_gc (void)
{
gc_state.n_cycles[GC_STAT_TOTAL]++;
gc_state.n_cycles[GC_STAT_IN_THIS_GC]++;
GC_STAT_RESUME (enqueued);
GC_STAT_RESUME (dequeued);
GC_STAT_RESUME (repushed);
GC_STAT_RESUME (finalized);
GC_STAT_RESUME (enqueued2);
GC_STAT_RESUME (dequeued2);
GC_STAT_RESUME (freed);
}
void
gc_stat_finalized (void)
{
GC_STAT_TICK (finalized);
}
void
gc_stat_freed (void)
{
GC_STAT_TICK (freed);
}
void
gc_stat_explicitly_freed (void)
{
gc_state.explicitly_freed++;
}
void
gc_stat_explicitly_tried_freed (void)
{
gc_state.explicitly_tried_freed++;
}
#define GC_STAT_PRINT_ONE(stat) \
printf (" | %9s %10d %10d %10d %10d %10d\n", \
#stat, \
(int) gc_state.stat[GC_STAT_TOTAL], \
(int) gc_state.stat[GC_STAT_IN_LAST_GC], \
(int) gc_state.stat[GC_STAT_IN_THIS_GC], \
(int) gc_state.stat[GC_STAT_IN_LAST_CYCLE], \
(int) gc_state.stat[GC_STAT_IN_THIS_CYCLE])
void
gc_stat_print_stats (void)
{
printf (" | PHASE %d TOTAL_GC %d\n",
(int) GC_PHASE,
(int) gc_state.n_gc[GC_STAT_TOTAL]);
printf (" | %9s %10s %10s %10s %10s %10s\n",
"stat", "total", "last_gc", "this_gc",
"last_cycle", "this_cycle");
printf (" | %9s %10d %10d %10d \n",
"cycle", (int) gc_state.n_cycles[GC_STAT_TOTAL],
(int) gc_state.n_cycles[GC_STAT_IN_LAST_GC],
(int) gc_state.n_cycles[GC_STAT_IN_THIS_GC]);
GC_STAT_PRINT_ONE (enqueued);
GC_STAT_PRINT_ONE (dequeued);
GC_STAT_PRINT_ONE (repushed);
GC_STAT_PRINT_ONE (enqueued2);
GC_STAT_PRINT_ONE (dequeued2);
GC_STAT_PRINT_ONE (finalized);
GC_STAT_PRINT_ONE (freed);
printf (" | explicitly freed %d tried %d\n",
(int) gc_state.explicitly_freed,
(int) gc_state.explicitly_tried_freed);
}
DEFUN("gc-stats", Fgc_stats, 0, 0 ,"", /*
Return statistics about garbage collection cycles in a property list.
*/
())
{
Lisp_Object pl = Qnil;
#define PL(name,value) \
pl = cons3 (intern (name), make_int ((int) gc_state.value), pl)
PL ("explicitly-tried-freed", explicitly_tried_freed);
PL ("explicitly-freed", explicitly_freed);
PL ("freed-in-this-cycle", freed[GC_STAT_IN_THIS_CYCLE]);
PL ("freed-in-this-gc", freed[GC_STAT_IN_THIS_GC]);
PL ("freed-in-last-cycle", freed[GC_STAT_IN_LAST_CYCLE]);
PL ("freed-in-last-gc", freed[GC_STAT_IN_LAST_GC]);
PL ("freed-total", freed[GC_STAT_TOTAL]);
PL ("finalized-in-this-cycle", finalized[GC_STAT_IN_THIS_CYCLE]);
PL ("finalized-in-this-gc", finalized[GC_STAT_IN_THIS_GC]);
PL ("finalized-in-last-cycle", finalized[GC_STAT_IN_LAST_CYCLE]);
PL ("finalized-in-last-gc", finalized[GC_STAT_IN_LAST_GC]);
PL ("finalized-total", finalized[GC_STAT_TOTAL]);
PL ("repushed-in-this-cycle", repushed[GC_STAT_IN_THIS_CYCLE]);
PL ("repushed-in-this-gc", repushed[GC_STAT_IN_THIS_GC]);
PL ("repushed-in-last-cycle", repushed[GC_STAT_IN_LAST_CYCLE]);
PL ("repushed-in-last-gc", repushed[GC_STAT_IN_LAST_GC]);
PL ("repushed-total", repushed[GC_STAT_TOTAL]);
PL ("dequeued2-in-this-cycle", dequeued2[GC_STAT_IN_THIS_CYCLE]);
PL ("dequeued2-in-this-gc", dequeued2[GC_STAT_IN_THIS_GC]);
PL ("dequeued2-in-last-cycle", dequeued2[GC_STAT_IN_LAST_CYCLE]);
PL ("dequeued2-in-last-gc", dequeued2[GC_STAT_IN_LAST_GC]);
PL ("dequeued2-total", dequeued2[GC_STAT_TOTAL]);
PL ("enqueued2-in-this-cycle", enqueued2[GC_STAT_IN_THIS_CYCLE]);
PL ("enqueued2-in-this-gc", enqueued2[GC_STAT_IN_THIS_GC]);
PL ("enqueued2-in-last-cycle", enqueued2[GC_STAT_IN_LAST_CYCLE]);
PL ("enqueued2-in-last-gc", enqueued2[GC_STAT_IN_LAST_GC]);
PL ("enqueued2-total", enqueued2[GC_STAT_TOTAL]);
PL ("dequeued-in-this-cycle", dequeued[GC_STAT_IN_THIS_CYCLE]);
PL ("dequeued-in-this-gc", dequeued[GC_STAT_IN_THIS_GC]);
PL ("dequeued-in-last-cycle", dequeued[GC_STAT_IN_LAST_CYCLE]);
PL ("dequeued-in-last-gc", dequeued[GC_STAT_IN_LAST_GC]);
PL ("dequeued-total", dequeued[GC_STAT_TOTAL]);
PL ("enqueued-in-this-cycle", enqueued[GC_STAT_IN_THIS_CYCLE]);
PL ("enqueued-in-this-gc", enqueued[GC_STAT_IN_THIS_GC]);
PL ("enqueued-in-last-cycle", enqueued[GC_STAT_IN_LAST_CYCLE]);
PL ("enqueued-in-last-gc", enqueued[GC_STAT_IN_LAST_GC]);
PL ("enqueued-total", enqueued[GC_STAT_TOTAL]);
PL ("n-cycles-in-this-gc", n_cycles[GC_STAT_IN_THIS_GC]);
PL ("n-cycles-in-last-gc", n_cycles[GC_STAT_IN_LAST_GC]);
PL ("n-cycles-total", n_cycles[GC_STAT_TOTAL]);
PL ("n-gc-total", n_gc[GC_STAT_TOTAL]);
PL ("phase", phase);
return pl;
}
#else /* not ERROR_CHECK_GC */
# define GC_STAT_START_NEW_GC
# define GC_STAT_RESUME_GC
# define GC_STAT_ENQUEUED
# define GC_STAT_DEQUEUED
# define GC_STAT_REPUSHED
# define GC_STAT_REMOVED
#endif /* not ERROR_CHECK_GC */
#endif /* NEW_GC */
/************************************************************************/
/* Recompute need to garbage collect */
/************************************************************************/
int need_to_garbage_collect;
#ifdef ERROR_CHECK_GC
int always_gc = 0; /* Debugging hack; equivalent to
(setq gc-cons-thresold -1) */
#else
#define always_gc 0
#endif
/* True if it's time to garbage collect now. */
void
recompute_need_to_garbage_collect (void)
{
if (always_gc)
need_to_garbage_collect = 1;
else
need_to_garbage_collect =
#ifdef NEW_GC
write_barrier_enabled ?
(consing_since_gc > gc_cons_incremental_threshold) :
#endif /* NEW_GC */
(consing_since_gc > gc_cons_threshold
&&
#if 0 /* #### implement this better */
(100 * consing_since_gc) / total_data_usage () >=
gc_cons_percentage
#else
(!total_gc_usage_set ||
(100 * consing_since_gc) / total_gc_usage >=
gc_cons_percentage)
#endif
);
recompute_funcall_allocation_flag ();
}
/************************************************************************/
/* Mark Phase */
/************************************************************************/
static const struct memory_description lisp_object_description_1[] = {
{ XD_LISP_OBJECT, 0 },
{ XD_END }
};
const struct sized_memory_description lisp_object_description = {
sizeof (Lisp_Object),
lisp_object_description_1
};
#if defined (USE_KKCC) || defined (PDUMP)
/* This function extracts the value of a count variable described somewhere
else in the description. It is converted corresponding to the type */
EMACS_INT
lispdesc_indirect_count_1 (EMACS_INT code,
const struct memory_description *idesc,
const void *idata)
{
EMACS_INT count;
const void *irdata;
int line = XD_INDIRECT_VAL (code);
int delta = XD_INDIRECT_DELTA (code);
irdata = ((char *) idata) +
lispdesc_indirect_count (idesc[line].offset, idesc, idata);
switch (idesc[line].type)
{
case XD_BYTECOUNT:
count = * (Bytecount *) irdata;
break;
case XD_ELEMCOUNT:
count = * (Elemcount *) irdata;
break;
case XD_HASHCODE:
count = * (Hashcode *) irdata;
break;
case XD_INT:
count = * (int *) irdata;
break;
case XD_LONG:
count = * (long *) irdata;
break;
default:
stderr_out ("Unsupported count type : %d (line = %d, code = %ld)\n",
idesc[line].type, line, (long) code);
#if defined(USE_KKCC) && defined(DEBUG_XEMACS)
if (gc_in_progress)
kkcc_backtrace ();
#endif
#ifdef PDUMP
if (in_pdump)
pdump_backtrace ();
#endif
count = 0; /* warning suppression */
ABORT ();
}
count += delta;
return count;
}
/* SDESC is a "description map" (basically, a list of offsets used for
successive indirections) and OBJ is the first object to indirect off of.
Return the description ultimately found. */
const struct sized_memory_description *
lispdesc_indirect_description_1 (const void *obj,
const struct sized_memory_description *sdesc)
{
int pos;
for (pos = 0; sdesc[pos].size >= 0; pos++)
obj = * (const void **) ((const char *) obj + sdesc[pos].size);
return (const struct sized_memory_description *) obj;
}
/* Compute the size of the data at RDATA, described by a single entry
DESC1 in a description array. OBJ and DESC are used for
XD_INDIRECT references. */
static Bytecount
lispdesc_one_description_line_size (void *rdata,
const struct memory_description *desc1,
const void *obj,
const struct memory_description *desc)
{
union_switcheroo:
switch (desc1->type)
{
case XD_LISP_OBJECT_ARRAY:
{
EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj);
return (val * sizeof (Lisp_Object));
}
case XD_LISP_OBJECT:
case XD_LO_LINK:
return sizeof (Lisp_Object);
case XD_OPAQUE_PTR:
return sizeof (void *);
#ifdef NEW_GC
case XD_LISP_OBJECT_BLOCK_PTR:
#endif /* NEW_GC */
case XD_BLOCK_PTR:
{
EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj);
return val * sizeof (void *);
}
case XD_BLOCK_ARRAY:
{
EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj);
return (val *
lispdesc_block_size
(rdata,
lispdesc_indirect_description (obj, desc1->data2.descr)));
}
case XD_OPAQUE_DATA_PTR:
return sizeof (void *);
case XD_UNION_DYNAMIC_SIZE:
{
/* If an explicit size was given in the first-level structure
description, use it; else compute size based on current union
constant. */
const struct sized_memory_description *sdesc =
lispdesc_indirect_description (obj, desc1->data2.descr);
if (sdesc->size)
return sdesc->size;
else
{
desc1 = lispdesc_process_xd_union (desc1, desc, obj);
if (desc1)
goto union_switcheroo;
break;
}
}
case XD_UNION:
{
/* If an explicit size was given in the first-level structure
description, use it; else compute size based on maximum of all
possible structures. */
const struct sized_memory_description *sdesc =
lispdesc_indirect_description (obj, desc1->data2.descr);
if (sdesc->size)
return sdesc->size;
else
{
int count;
Bytecount max_size = -1, size;
desc1 = sdesc->description;
for (count = 0; desc1[count].type != XD_END; count++)
{
size = lispdesc_one_description_line_size (rdata,
&desc1[count],
obj, desc);
if (size > max_size)
max_size = size;
}
return max_size;
}
}
case XD_ASCII_STRING:
return sizeof (void *);
case XD_DOC_STRING:
return sizeof (void *);
case XD_INT_RESET:
return sizeof (int);
case XD_BYTECOUNT:
return sizeof (Bytecount);
case XD_ELEMCOUNT:
return sizeof (Elemcount);
case XD_HASHCODE:
return sizeof (Hashcode);
case XD_INT:
return sizeof (int);
case XD_LONG:
return sizeof (long);
default:
stderr_out ("Unsupported dump type : %d\n", desc1->type);
ABORT ();
}
return 0;
}
/* Return the size of the memory block (NOT necessarily a structure!)
described by SDESC and pointed to by OBJ. If SDESC records an
explicit size (i.e. non-zero), it is simply returned; otherwise,
the size is calculated by the maximum offset and the size of the
object at that offset, rounded up to the maximum alignment. In
this case, we may need the object, for example when retrieving an
"indirect count" of an inlined array (the count is not constant,
but is specified by one of the elements of the memory block). (It
is generally not a problem if we return an overly large size -- we
will simply end up reserving more space than necessary; but if the
size is too small we could be in serious trouble, in particular
with nested inlined structures, where there may be alignment
padding in the middle of a block. #### In fact there is an (at
least theoretical) problem with an overly large size -- we may
trigger a protection fault when reading from invalid memory. We
need to handle this -- perhaps in a stupid but dependable way,
i.e. by trapping SIGSEGV and SIGBUS.) */
Bytecount
lispdesc_block_size_1 (const void *obj, Bytecount size,
const struct memory_description *desc)
{
EMACS_INT max_offset = -1;
int max_offset_pos = -1;
int pos;
if (size)
return size;
for (pos = 0; desc[pos].type != XD_END; pos++)
{
EMACS_INT offset = lispdesc_indirect_count (desc[pos].offset, desc, obj);
if (offset == max_offset)
{
stderr_out ("Two relocatable elements at same offset?\n");
ABORT ();
}
else if (offset > max_offset)
{
max_offset = offset;
max_offset_pos = pos;
}
}
if (max_offset_pos < 0)
return 0;
{
Bytecount size_at_max;
size_at_max =
lispdesc_one_description_line_size ((char *) obj + max_offset,
&desc[max_offset_pos], obj, desc);
/* We have no way of knowing the required alignment for this structure,
so just make it maximally aligned. */
return MAX_ALIGN_SIZE (max_offset + size_at_max);
}
}
#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 old_lcrecord_header *) lheader)->free)
#endif /* MC_ALLOC */
#ifdef USE_KKCC
/* The following functions implement the new mark algorithm.
They mark objects according to their descriptions. They
are modeled on the corresponding pdumper procedures. */
#if 0
# define KKCC_STACK_AS_QUEUE 1
#endif
#ifdef DEBUG_XEMACS
/* The backtrace for the KKCC mark functions. */
#define KKCC_INIT_BT_STACK_SIZE 4096
typedef struct
{
void *obj;
const struct memory_description *desc;
int pos;
} kkcc_bt_stack_entry;
static kkcc_bt_stack_entry *kkcc_bt;
static int kkcc_bt_stack_size;
static int kkcc_bt_depth = 0;
static void
kkcc_bt_init (void)
{
kkcc_bt_depth = 0;
kkcc_bt_stack_size = KKCC_INIT_BT_STACK_SIZE;
kkcc_bt = (kkcc_bt_stack_entry *)
xmalloc_and_zero (kkcc_bt_stack_size * sizeof (kkcc_bt_stack_entry));
if (!kkcc_bt)
{
stderr_out ("KKCC backtrace stack init failed for size %d\n",
kkcc_bt_stack_size);
ABORT ();
}
}
void
kkcc_backtrace (void)
{
int i;
stderr_out ("KKCC mark stack backtrace :\n");
for (i = kkcc_bt_depth - 1; i >= 0; i--)
{
Lisp_Object obj = wrap_pointer_1 (kkcc_bt[i].obj);
stderr_out (" [%d]", i);
if ((XRECORD_LHEADER (obj)->type >= lrecord_type_last_built_in_type)
|| (!LRECORDP (obj))
|| (!XRECORD_LHEADER_IMPLEMENTATION (obj)))
{
stderr_out (" non Lisp Object");
}
else
{
stderr_out (" %s",
XRECORD_LHEADER_IMPLEMENTATION (obj)->name);
}
stderr_out (" (addr: 0x%x, desc: 0x%x, ",
(int) kkcc_bt[i].obj,
(int) kkcc_bt[i].desc);
if (kkcc_bt[i].pos >= 0)
stderr_out ("pos: %d)\n", kkcc_bt[i].pos);
else
if (kkcc_bt[i].pos == -1)
stderr_out ("root set)\n");
else if (kkcc_bt[i].pos == -2)
stderr_out ("dirty object)\n");
}
}
static void
kkcc_bt_stack_realloc (void)
{
kkcc_bt_stack_size *= 2;
kkcc_bt = (kkcc_bt_stack_entry *)
xrealloc (kkcc_bt, kkcc_bt_stack_size * sizeof (kkcc_bt_stack_entry));
if (!kkcc_bt)
{
stderr_out ("KKCC backtrace stack realloc failed for size %d\n",
kkcc_bt_stack_size);
ABORT ();
}
}
static void
kkcc_bt_free (void)
{
xfree_1 (kkcc_bt);
kkcc_bt = 0;
kkcc_bt_stack_size = 0;
}
static void
kkcc_bt_push (void *obj, const struct memory_description *desc,
int level, int pos)
{
kkcc_bt_depth = level;
kkcc_bt[kkcc_bt_depth].obj = obj;
kkcc_bt[kkcc_bt_depth].desc = desc;
kkcc_bt[kkcc_bt_depth].pos = pos;
kkcc_bt_depth++;
if (kkcc_bt_depth >= kkcc_bt_stack_size)
kkcc_bt_stack_realloc ();
}
#else /* not DEBUG_XEMACS */
#define kkcc_bt_init()
#define kkcc_bt_push(obj, desc, level, pos)
#endif /* not DEBUG_XEMACS */
/* Object memory descriptions are in the lrecord_implementation structure.
But copying them to a parallel array is much more cache-friendly. */
const struct memory_description *lrecord_memory_descriptions[countof (lrecord_implementations_table)];
/* the initial stack size in kkcc_gc_stack_entries */
#define KKCC_INIT_GC_STACK_SIZE 16384
typedef struct
{
void *data;
const struct memory_description *desc;
#ifdef DEBUG_XEMACS
int level;
int pos;
#endif
} kkcc_gc_stack_entry;
static kkcc_gc_stack_entry *kkcc_gc_stack_ptr;
static int kkcc_gc_stack_front;
static int kkcc_gc_stack_rear;
static int kkcc_gc_stack_size;
#define KKCC_INC(i) ((i + 1) % kkcc_gc_stack_size)
#define KKCC_INC2(i) ((i + 2) % kkcc_gc_stack_size)
#define KKCC_GC_STACK_FULL (KKCC_INC2 (kkcc_gc_stack_rear) == kkcc_gc_stack_front)
#define KKCC_GC_STACK_EMPTY (KKCC_INC (kkcc_gc_stack_rear) == kkcc_gc_stack_front)
static void
kkcc_gc_stack_init (void)
{
kkcc_gc_stack_size = KKCC_INIT_GC_STACK_SIZE;
kkcc_gc_stack_ptr = (kkcc_gc_stack_entry *)
xmalloc_and_zero (kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry));
if (!kkcc_gc_stack_ptr)
{
stderr_out ("stack init failed for size %d\n", kkcc_gc_stack_size);
ABORT ();
}
kkcc_gc_stack_front = 0;
kkcc_gc_stack_rear = kkcc_gc_stack_size - 1;
}
static void
kkcc_gc_stack_free (void)
{
xfree_1 (kkcc_gc_stack_ptr);
kkcc_gc_stack_ptr = 0;
kkcc_gc_stack_front = 0;
kkcc_gc_stack_rear = 0;
kkcc_gc_stack_size = 0;
}
static void
kkcc_gc_stack_realloc (void)
{
kkcc_gc_stack_entry *old_ptr = kkcc_gc_stack_ptr;
int old_size = kkcc_gc_stack_size;
kkcc_gc_stack_size *= 2;
kkcc_gc_stack_ptr = (kkcc_gc_stack_entry *)
xmalloc_and_zero (kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry));
if (!kkcc_gc_stack_ptr)
{
stderr_out ("stack realloc failed for size %d\n", kkcc_gc_stack_size);
ABORT ();
}
if (kkcc_gc_stack_rear >= kkcc_gc_stack_front)
{
int number_elements = kkcc_gc_stack_rear - kkcc_gc_stack_front + 1;
memcpy (kkcc_gc_stack_ptr, &old_ptr[kkcc_gc_stack_front],
number_elements * sizeof (kkcc_gc_stack_entry));
kkcc_gc_stack_front = 0;
kkcc_gc_stack_rear = number_elements - 1;
}
else
{
int number_elements = old_size - kkcc_gc_stack_front;
memcpy (kkcc_gc_stack_ptr, &old_ptr[kkcc_gc_stack_front],
number_elements * sizeof (kkcc_gc_stack_entry));
memcpy (&kkcc_gc_stack_ptr[number_elements], &old_ptr[0],
(kkcc_gc_stack_rear + 1) * sizeof (kkcc_gc_stack_entry));
kkcc_gc_stack_front = 0;
kkcc_gc_stack_rear = kkcc_gc_stack_rear + number_elements;
}
xfree_1 (old_ptr);
}
static void
#ifdef DEBUG_XEMACS
kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc,
int level, int pos)
#else
kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc)
#endif
{
#ifdef NEW_GC
GC_STAT_ENQUEUED;
#endif /* NEW_GC */
if (KKCC_GC_STACK_FULL)
kkcc_gc_stack_realloc();
kkcc_gc_stack_rear = KKCC_INC (kkcc_gc_stack_rear);
kkcc_gc_stack_ptr[kkcc_gc_stack_rear].data = data;
kkcc_gc_stack_ptr[kkcc_gc_stack_rear].desc = desc;
#ifdef DEBUG_XEMACS
kkcc_gc_stack_ptr[kkcc_gc_stack_rear].level = level;
kkcc_gc_stack_ptr[kkcc_gc_stack_rear].pos = pos;
#endif
}
#ifdef DEBUG_XEMACS
#define kkcc_gc_stack_push(data, desc, level, pos) \
kkcc_gc_stack_push_1 (data, desc, level, pos)
#else
#define kkcc_gc_stack_push(data, desc, level, pos) \
kkcc_gc_stack_push_1 (data, desc)
#endif
static kkcc_gc_stack_entry *
kkcc_gc_stack_pop (void)
{
if (KKCC_GC_STACK_EMPTY)
return 0;
#ifdef NEW_GC
GC_STAT_DEQUEUED;
#endif /* NEW_GC */
#ifndef KKCC_STACK_AS_QUEUE
/* stack behaviour */
return &kkcc_gc_stack_ptr[kkcc_gc_stack_rear--];
#else
/* queue behaviour */
{
int old_front = kkcc_gc_stack_front;
kkcc_gc_stack_front = KKCC_INC (kkcc_gc_stack_front);
return &kkcc_gc_stack_ptr[old_front];
}
#endif
}
void
#ifdef DEBUG_XEMACS
kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos)
#else
kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj)
#endif
{
if (XTYPE (obj) == Lisp_Type_Record)
{
struct lrecord_header *lheader = XRECORD_LHEADER (obj);
const struct memory_description *desc;
GC_CHECK_LHEADER_INVARIANTS (lheader);
desc = RECORD_DESCRIPTION (lheader);
if (! MARKED_RECORD_HEADER_P (lheader))
{
#ifdef NEW_GC
MARK_GREY (lheader);
#else /* not NEW_GC */
MARK_RECORD_HEADER (lheader);
#endif /* not NEW_GC */
kkcc_gc_stack_push ((void *) lheader, desc, level, pos);
}
}
}
#ifdef NEW_GC
#ifdef DEBUG_XEMACS
#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \
kkcc_gc_stack_push_lisp_object_1 (obj, level, pos)
#else
#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \
kkcc_gc_stack_push_lisp_object_1 (obj)
#endif
void
#ifdef DEBUG_XEMACS
kkcc_gc_stack_repush_dirty_object_1 (Lisp_Object obj, int level, int pos)
#else
kkcc_gc_stack_repush_dirty_object_1 (Lisp_Object obj)
#endif
{
if (XTYPE (obj) == Lisp_Type_Record)
{
struct lrecord_header *lheader = XRECORD_LHEADER (obj);
const struct memory_description *desc;
GC_STAT_REPUSHED;
GC_CHECK_LHEADER_INVARIANTS (lheader);
desc = RECORD_DESCRIPTION (lheader);
MARK_GREY (lheader);
kkcc_gc_stack_push ((void*) lheader, desc, level, pos);
}
}
#endif /* NEW_GC */
#ifdef ERROR_CHECK_GC
#define KKCC_DO_CHECK_FREE(obj, allow_free) \
do \
{ \
if (!allow_free && XTYPE (obj) == Lisp_Type_Record) \
{ \
struct lrecord_header *lheader = XRECORD_LHEADER (obj); \
GC_CHECK_NOT_FREE (lheader); \
} \
} while (0)
#else
#define KKCC_DO_CHECK_FREE(obj, allow_free)
#endif
#ifdef ERROR_CHECK_GC
#ifdef DEBUG_XEMACS
static void
mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free,
int level, int pos)
#else
static void
mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free)
#endif
{
KKCC_DO_CHECK_FREE (obj, allow_free);
kkcc_gc_stack_push_lisp_object (obj, level, pos);
}
#ifdef DEBUG_XEMACS
#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \
mark_object_maybe_checking_free_1 (obj, allow_free, level, pos)
#else
#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \
mark_object_maybe_checking_free_1 (obj, allow_free)
#endif
#else /* not ERROR_CHECK_GC */
#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \
kkcc_gc_stack_push_lisp_object (obj, level, pos)
#endif /* not ERROR_CHECK_GC */
/* This function loops all elements of a struct pointer and calls
mark_with_description with each element. */
static void
#ifdef DEBUG_XEMACS
mark_struct_contents_1 (const void *data,
const struct sized_memory_description *sdesc,
int count, int level, int pos)
#else
mark_struct_contents_1 (const void *data,
const struct sized_memory_description *sdesc,
int count)
#endif
{
int i;
Bytecount elsize;
elsize = lispdesc_block_size (data, sdesc);
for (i = 0; i < count; i++)
{
kkcc_gc_stack_push (((char *) data) + elsize * i, sdesc->description,
level, pos);
}
}
#ifdef DEBUG_XEMACS
#define mark_struct_contents(data, sdesc, count, level, pos) \
mark_struct_contents_1 (data, sdesc, count, level, pos)
#else
#define mark_struct_contents(data, sdesc, count, level, pos) \
mark_struct_contents_1 (data, sdesc, count)
#endif
#ifdef NEW_GC
/* This function loops all elements of a struct pointer and calls
mark_with_description with each element. */
static void
#ifdef DEBUG_XEMACS
mark_lisp_object_block_contents_1 (const void *data,
const struct sized_memory_description *sdesc,
int count, int level, int pos)
#else
mark_lisp_object_block_contents_1 (const void *data,
const struct sized_memory_description *sdesc,
int count)
#endif
{
int i;
Bytecount elsize;
elsize = lispdesc_block_size (data, sdesc);
for (i = 0; i < count; i++)
{
const Lisp_Object obj = wrap_pointer_1 (((char *) data) + elsize * i);
if (XTYPE (obj) == Lisp_Type_Record)
{
struct lrecord_header *lheader = XRECORD_LHEADER (obj);
const struct memory_description *desc;
GC_CHECK_LHEADER_INVARIANTS (lheader);
desc = sdesc->description;
if (! MARKED_RECORD_HEADER_P (lheader))
{
MARK_GREY (lheader);
kkcc_gc_stack_push ((void *) lheader, desc, level, pos);
}
}
}
}
#ifdef DEBUG_XEMACS
#define mark_lisp_object_block_contents(data, sdesc, count, level, pos) \
mark_lisp_object_block_contents_1 (data, sdesc, count, level, pos)
#else
#define mark_lisp_object_block_contents(data, sdesc, count, level, pos) \
mark_lisp_object_block_contents_1 (data, sdesc, count)
#endif
#endif /* not NEW_GC */
/* This function implements the KKCC mark algorithm.
Instead of calling mark_object, all the alive Lisp_Objects are pushed
on the kkcc_gc_stack. This function processes all elements on the stack
according to their descriptions. */
static void
kkcc_marking (
#ifdef NEW_GC
int cnt
#else /* not NEW_GC */
int UNUSED(cnt)
#endif /* not NEW_GC */
)
{
kkcc_gc_stack_entry *stack_entry = 0;
void *data = 0;
const struct memory_description *desc = 0;
int pos;
#ifdef NEW_GC
int count = cnt;
#endif /* NEW_GC */
#ifdef DEBUG_XEMACS
int level = 0;
#endif
while ((stack_entry = kkcc_gc_stack_pop ()) != 0)
{
data = stack_entry->data;
desc = stack_entry->desc;
#ifdef DEBUG_XEMACS
level = stack_entry->level + 1;
#endif
kkcc_bt_push (data, desc, stack_entry->level, stack_entry->pos);
#ifdef NEW_GC
/* Mark black if object is currently grey. This first checks,
if the object is really allocated on the mc-heap. If it is,
it can be marked black; if it is not, it cannot be marked. */
maybe_mark_black (data);
#endif /* NEW_GC */
if (!data) continue;
gc_checking_assert (data);
gc_checking_assert (desc);
for (pos = 0; desc[pos].type != XD_END; pos++)
{
const struct memory_description *desc1 = &desc[pos];
const void *rdata =
(const char *) data + lispdesc_indirect_count (desc1->offset,
desc, data);
union_switcheroo:
/* If the flag says don't mark, then don't mark. */
if ((desc1->flags) & XD_FLAG_NO_KKCC)
continue;
switch (desc1->type)
{
case XD_BYTECOUNT:
case XD_ELEMCOUNT:
case XD_HASHCODE:
case XD_INT:
case XD_LONG:
case XD_INT_RESET:
case XD_LO_LINK:
case XD_OPAQUE_PTR:
case XD_OPAQUE_DATA_PTR:
case XD_ASCII_STRING:
case XD_DOC_STRING:
break;
case XD_LISP_OBJECT:
{
const Lisp_Object *stored_obj = (const Lisp_Object *) rdata;
/* Because of the way that tagged objects work (pointers and
Lisp_Objects have the same representation), XD_LISP_OBJECT
can be used for untagged pointers. They might be NULL,
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);
#endif /* not MC_ALLOC */
break;
}
case XD_LISP_OBJECT_ARRAY:
{
int i;
EMACS_INT count =
lispdesc_indirect_count (desc1->data1, desc, data);
for (i = 0; i < count; i++)
{
const Lisp_Object *stored_obj =
(const Lisp_Object *) rdata + i;
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;
}
#ifdef NEW_GC
case XD_LISP_OBJECT_BLOCK_PTR:
{
EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
data);
const struct sized_memory_description *sdesc =
lispdesc_indirect_description (data, desc1->data2.descr);
const char *dobj = * (const char **) rdata;
if (dobj)
mark_lisp_object_block_contents
(dobj, sdesc, count, level, pos);
break;
}
#endif /* NEW_GC */
case XD_BLOCK_PTR:
{
EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
data);
const struct sized_memory_description *sdesc =
lispdesc_indirect_description (data, desc1->data2.descr);
const char *dobj = * (const char **) rdata;
if (dobj)
mark_struct_contents (dobj, sdesc, count, level, pos);
break;
}
case XD_BLOCK_ARRAY:
{
EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
data);
const struct sized_memory_description *sdesc =
lispdesc_indirect_description (data, desc1->data2.descr);
mark_struct_contents (rdata, sdesc, count, level, pos);
break;
}
case XD_UNION:
case XD_UNION_DYNAMIC_SIZE:
desc1 = lispdesc_process_xd_union (desc1, desc, data);
if (desc1)
goto union_switcheroo;
break;
default:
stderr_out ("Unsupported description type : %d\n", desc1->type);
kkcc_backtrace ();
ABORT ();
}
}
#ifdef NEW_GC
if (cnt)
if (!--count)
break;
#endif /* NEW_GC */
}
}
#endif /* USE_KKCC */
/* I hate duplicating all this crap! */
int
marked_p (Lisp_Object obj)
{
/* Checks we used to perform. */
/* if (EQ (obj, Qnull_pointer)) return 1; */
/* if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1; */
/* if (PURIFIED (XPNTR (obj))) return 1; */
if (XTYPE (obj) == Lisp_Type_Record)
{
struct lrecord_header *lheader = XRECORD_LHEADER (obj);
GC_CHECK_LHEADER_INVARIANTS (lheader);
return MARKED_RECORD_HEADER_P (lheader);
}
return 1;
}
/* Mark reference to a Lisp_Object. If the object referred to has not been
seen yet, recursively mark all the references contained in it. */
void
mark_object (
#ifdef USE_KKCC
Lisp_Object UNUSED (obj)
#else
Lisp_Object obj
#endif
)
{
#ifdef USE_KKCC
/* this code should never be reached when configured for KKCC */
stderr_out ("KKCC: Invalid mark_object call.\n");
stderr_out ("Replace mark_object with kkcc_gc_stack_push_lisp_object.\n");
ABORT ();
#else /* not USE_KKCC */
tail_recurse:
/* Checks we used to perform */
/* if (EQ (obj, Qnull_pointer)) return; */
/* if (!POINTER_TYPE_P (XGCTYPE (obj))) return; */
/* if (PURIFIED (XPNTR (obj))) return; */
if (XTYPE (obj) == Lisp_Type_Record)
{
struct lrecord_header *lheader = XRECORD_LHEADER (obj);
GC_CHECK_LHEADER_INVARIANTS (lheader);
/* We handle this separately, above, so we can mark free objects */
GC_CHECK_NOT_FREE (lheader);
/* All c_readonly objects have their mark bit set,
so that we only need to check the mark bit here. */
if (! MARKED_RECORD_HEADER_P (lheader))
{
MARK_RECORD_HEADER (lheader);
if (RECORD_MARKER (lheader))
{
obj = RECORD_MARKER (lheader) (obj);
if (!NILP (obj)) goto tail_recurse;
}
}
}
#endif /* not KKCC */
}
/************************************************************************/
/* Hooks */
/************************************************************************/
/* Nonzero when calling certain hooks or doing other things where a GC
would be bad. It prevents infinite recursive calls to gc. */
int gc_currently_forbidden;
int
begin_gc_forbidden (void)
{
return internal_bind_int (&gc_currently_forbidden, 1);
}
void
end_gc_forbidden (int count)
{
unbind_to (count);
}
/* Hooks. */
Lisp_Object Vpre_gc_hook, Qpre_gc_hook;
Lisp_Object Vpost_gc_hook, Qpost_gc_hook;
/* Maybe we want to use this when doing a "panic" gc after memory_full()? */
static int gc_hooks_inhibited;
struct post_gc_action
{
void (*fun) (void *);
void *arg;
};
typedef struct post_gc_action post_gc_action;
typedef struct
{
Dynarr_declare (post_gc_action);
} post_gc_action_dynarr;
static post_gc_action_dynarr *post_gc_actions;
/* Register an action to be called at the end of GC.
gc_in_progress is 0 when this is called.
This is used when it is discovered that an action needs to be taken,
but it's during GC, so it's not safe. (e.g. in a finalize method.)
As a general rule, do not use Lisp objects here.
And NEVER signal an error.
*/
void
register_post_gc_action (void (*fun) (void *), void *arg)
{
post_gc_action action;
if (!post_gc_actions)
post_gc_actions = Dynarr_new (post_gc_action);
action.fun = fun;
action.arg = arg;
Dynarr_add (post_gc_actions, action);
}
static void
run_post_gc_actions (void)
{
int i;
if (post_gc_actions)
{
for (i = 0; i < Dynarr_length (post_gc_actions); i++)
{
post_gc_action action = Dynarr_at (post_gc_actions, i);
(action.fun) (action.arg);
}
Dynarr_reset (post_gc_actions);
}
}
/************************************************************************/
/* Garbage Collection */
/************************************************************************/
/* Enable/disable incremental garbage collection during runtime. */
int allow_incremental_gc;
/* For profiling. */
static Lisp_Object QSin_garbage_collection;
/* Nonzero means display messages at beginning and end of GC. */
int garbage_collection_messages;
/* "Garbage collecting" */
Lisp_Object Vgc_message;
Lisp_Object Vgc_pointer_glyph;
static const Ascbyte gc_default_message[] = "Garbage collecting";
Lisp_Object Qgarbage_collecting;
/* "Locals" during GC. */
struct frame *f;
int speccount;
int cursor_changed;
Lisp_Object pre_gc_cursor;
/* PROFILE_DECLARE */
int do_backtrace;
struct backtrace backtrace;
/* Maximum amount of C stack to save when a GC happens. */
#ifndef MAX_SAVE_STACK
#define MAX_SAVE_STACK 0 /* 16000 */
#endif
void
gc_prepare (void)
{
#if MAX_SAVE_STACK > 0
char stack_top_variable;
extern char *stack_bottom;
#endif
#ifdef NEW_GC
GC_STAT_START_NEW_GC;
GC_SET_PHASE (INIT_GC);
#endif /* NEW_GC */
do_backtrace = profiling_active || backtrace_with_internal_sections;
assert (!gc_in_progress);
assert (!in_display || gc_currently_forbidden);
PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection);
/* We used to call selected_frame() here.
The following functions cannot be called inside GC
so we move to after the above tests. */
{
Lisp_Object frame;
Lisp_Object device = Fselected_device (Qnil);
if (NILP (device)) /* Could happen during startup, eg. if always_gc */
return;
frame = Fselected_frame (device);
if (NILP (frame))
invalid_state ("No frames exist on device", device);
f = XFRAME (frame);
}
pre_gc_cursor = Qnil;
cursor_changed = 0;
need_to_signal_post_gc = 0;
recompute_funcall_allocation_flag ();
if (!gc_hooks_inhibited)
run_hook_trapping_problems
(Qgarbage_collecting, Qpre_gc_hook,
INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
/* Now show the GC cursor/message. */
if (!noninteractive)
{
if (FRAME_WIN_P (f))
{
Lisp_Object frame = wrap_frame (f);
Lisp_Object cursor = glyph_image_instance (Vgc_pointer_glyph,
FRAME_SELECTED_WINDOW (f),
ERROR_ME_NOT, 1);
pre_gc_cursor = f->pointer;
if (POINTER_IMAGE_INSTANCEP (cursor)
/* don't change if we don't know how to change back. */
&& POINTER_IMAGE_INSTANCEP (pre_gc_cursor))
{
cursor_changed = 1;
Fset_frame_pointer (frame, cursor);
}
}
/* Don't print messages to the stream device. */
if (!cursor_changed && !FRAME_STREAM_P (f))
{
if (garbage_collection_messages)
{
Lisp_Object args[2], whole_msg;
args[0] = (STRINGP (Vgc_message) ? Vgc_message :
build_msg_string (gc_default_message));
args[1] = build_string ("...");
whole_msg = Fconcat (2, args);
echo_area_message (f, (Ibyte *) 0, whole_msg, 0, -1,
Qgarbage_collecting);
}
}
}
/***** Now we actually start the garbage collection. */
gc_in_progress = 1;
#ifndef NEW_GC
inhibit_non_essential_conversion_operations = 1;
#endif /* NEW_GC */
#if MAX_SAVE_STACK > 0
/* Save a copy of the contents of the stack, for debugging. */
if (!purify_flag)
{
/* Static buffer in which we save a copy of the C stack at each GC. */
static char *stack_copy;
static Bytecount stack_copy_size;
ptrdiff_t stack_diff = &stack_top_variable - stack_bottom;
Bytecount stack_size = (stack_diff > 0 ? stack_diff : -stack_diff);
if (stack_size < MAX_SAVE_STACK)
{
if (stack_copy_size < stack_size)
{
stack_copy = (char *) xrealloc (stack_copy, stack_size);
stack_copy_size = stack_size;
}
memcpy (stack_copy,
stack_diff > 0 ? stack_bottom : &stack_top_variable,
stack_size);
}
}
#endif /* MAX_SAVE_STACK > 0 */
/* Do some totally ad-hoc resource clearing. */
/* #### generalize this? */
clear_event_resource ();
cleanup_specifiers ();
cleanup_buffer_undo_lists ();
}
void
gc_mark_root_set (
#ifdef NEW_GC
enum gc_phase phase
#else /* not NEW_GC */
void
#endif /* not NEW_GC */
)
{
#ifdef NEW_GC
GC_SET_PHASE (phase);
#endif /* NEW_GC */
/* Mark all the special slots that serve as the roots of accessibility. */
#ifdef USE_KKCC
# define mark_object(obj) kkcc_gc_stack_push_lisp_object (obj, 0, -1)
#endif /* USE_KKCC */
{ /* staticpro() */
Lisp_Object **p = Dynarr_begin (staticpros);
Elemcount count;
for (count = Dynarr_length (staticpros); count; count--)
/* Need to check if the pointer in the staticpro array is not
NULL. A gc can occur after variable is added to the staticpro
array and _before_ it is correctly initialized. In this case
its value is NULL, which we have to catch here. */
if (*p)
mark_object (**p++);
else
**p++;
}
{ /* staticpro_nodump() */
Lisp_Object **p = Dynarr_begin (staticpros_nodump);
Elemcount count;
for (count = Dynarr_length (staticpros_nodump); count; count--)
/* Need to check if the pointer in the staticpro array is not
NULL. A gc can occur after variable is added to the staticpro
array and _before_ it is correctly initialized. In this case
its value is NULL, which we have to catch here. */
if (*p)
mark_object (**p++);
else
**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;
for (tail = gcprolist; tail; tail = tail->next)
for (i = 0; i < tail->nvars; i++)
mark_object (tail->var[i]);
}
{ /* specbind() */
struct specbinding *bind;
for (bind = specpdl; bind != specpdl_ptr; bind++)
{
mark_object (bind->symbol);
mark_object (bind->old_value);
}
}
{
struct catchtag *c;
for (c = catchlist; c; c = c->next)
{
mark_object (c->tag);
mark_object (c->val);
mark_object (c->actual_tag);
mark_object (c->backtrace);
}
}
{
struct backtrace *backlist;
for (backlist = backtrace_list; backlist; backlist = backlist->next)
{
int nargs = backlist->nargs;
int i;
mark_object (*backlist->function);
if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */
/* might be fake (internal profiling entry) */
&& backlist->args)
mark_object (backlist->args[0]);
else
for (i = 0; i < nargs; i++)
mark_object (backlist->args[i]);
}
}
mark_profiling_info ();
#ifdef USE_KKCC
# undef mark_object
#endif
}
void
gc_finish_mark (void)
{
#ifdef NEW_GC
GC_SET_PHASE (FINISH_MARK);
#endif /* NEW_GC */
init_marking_ephemerons ();
while (finish_marking_weak_hash_tables () > 0 ||
finish_marking_weak_lists () > 0 ||
continue_marking_ephemerons () > 0)
#ifdef USE_KKCC
{
kkcc_marking (0);
}
#else /* not USE_KKCC */
;
#endif /* not USE_KKCC */
/* At this point, we know which objects need to be finalized: we
still need to resurrect them */
while (finish_marking_ephemerons () > 0 ||
finish_marking_weak_lists () > 0 ||
finish_marking_weak_hash_tables () > 0)
#ifdef USE_KKCC
{
kkcc_marking (0);
}
#else /* not USE_KKCC */
;
#endif /* not USE_KKCC */
/* And prune (this needs to be called after everything else has been
marked and before we do any sweeping). */
/* #### this is somewhat ad-hoc and should probably be an object
method */
prune_weak_hash_tables ();
prune_weak_lists ();
prune_specifiers ();
prune_syntax_tables ();
prune_ephemerons ();
prune_weak_boxes ();
}
#ifdef NEW_GC
void
gc_finalize (void)
{
GC_SET_PHASE (FINALIZE);
mc_finalize ();
}
void
gc_sweep (void)
{
GC_SET_PHASE (SWEEP);
mc_sweep ();
}
#endif /* NEW_GC */
void
gc_finish (void)
{
#ifdef NEW_GC
GC_SET_PHASE (FINISH_GC);
#endif /* NEW_GC */
consing_since_gc = 0;
#ifndef DEBUG_XEMACS
/* Allow you to set it really fucking low if you really want ... */
if (gc_cons_threshold < 10000)
gc_cons_threshold = 10000;
#endif
recompute_need_to_garbage_collect ();
#ifndef NEW_GC
inhibit_non_essential_conversion_operations = 0;
#endif /* not NEW_GC */
gc_in_progress = 0;
run_post_gc_actions ();
/******* End of garbage collection ********/
/* Now remove the GC cursor/message */
if (!noninteractive)
{
if (cursor_changed)
Fset_frame_pointer (wrap_frame (f), pre_gc_cursor);
else if (!FRAME_STREAM_P (f))
{
/* Show "...done" only if the echo area would otherwise be empty. */
if (NILP (clear_echo_area (selected_frame (),
Qgarbage_collecting, 0)))
{
if (garbage_collection_messages)
{
Lisp_Object args[2], whole_msg;
args[0] = (STRINGP (Vgc_message) ? Vgc_message :
build_msg_string (gc_default_message));
args[1] = build_msg_string ("... done");
whole_msg = Fconcat (2, args);
echo_area_message (selected_frame (), (Ibyte *) 0,
whole_msg, 0, -1,
Qgarbage_collecting);
}
}
}
}
#ifndef MC_ALLOC
if (!breathing_space)
{
breathing_space = malloc (4096 - MALLOC_OVERHEAD);
}
#endif /* not MC_ALLOC */
need_to_signal_post_gc = 1;
funcall_allocation_flag = 1;
PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection);
#ifdef NEW_GC
GC_SET_PHASE (NONE);
#endif /* NEW_GC */
}
#ifdef NEW_GC
void
gc_suspend_mark_phase (void)
{
PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection);
write_barrier_enabled = 1;
consing_since_gc = 0;
vdb_start_dirty_bits_recording ();
}
int
gc_resume_mark_phase (void)
{
PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection);
assert (write_barrier_enabled);
vdb_stop_dirty_bits_recording ();
write_barrier_enabled = 0;
return vdb_read_dirty_bits ();
}
int
gc_mark (int incremental)
{
GC_SET_PHASE (MARK);
if (!incremental)
{
kkcc_marking (0);
}
else
{
kkcc_marking (gc_incremental_traversal_threshold);
if (!KKCC_GC_STACK_EMPTY)
{
gc_suspend_mark_phase ();
return 0;
}
}
return 1;
}
int
gc_resume_mark (int incremental)
{
if (!incremental)
{
if (!KKCC_GC_STACK_EMPTY)
{
GC_STAT_RESUME_GC;
/* An incremental garbage collection is already running ---
now wrap it up and resume it atomically. */
gc_resume_mark_phase ();
gc_mark_root_set (REPUSH_ROOT_SET);
kkcc_marking (0);
}
}
else
{
int repushed_objects;
int mark_work;
GC_STAT_RESUME_GC;
repushed_objects = gc_resume_mark_phase ();
mark_work = (gc_incremental_traversal_threshold > repushed_objects) ?
gc_incremental_traversal_threshold : repushed_objects;
kkcc_marking (mark_work);
if (KKCC_GC_STACK_EMPTY)
{
/* Mark root set again and finish up marking. */
gc_mark_root_set (REPUSH_ROOT_SET);
kkcc_marking (0);
}
else
{
gc_suspend_mark_phase ();
return 0;
}
}
return 1;
}
void
gc_1 (int incremental)
{
switch (GC_PHASE)
{
case NONE:
gc_prepare ();
kkcc_gc_stack_init();
#ifdef DEBUG_XEMACS
kkcc_bt_init ();
#endif
case INIT_GC:
gc_mark_root_set (PUSH_ROOT_SET);
case PUSH_ROOT_SET:
if (!gc_mark (incremental))
return; /* suspend gc */
case MARK:
if (!KKCC_GC_STACK_EMPTY)
if (!gc_resume_mark (incremental))
return; /* suspend gc */
gc_finish_mark ();
kkcc_gc_stack_free ();
#ifdef DEBUG_XEMACS
kkcc_bt_free ();
#endif
case FINISH_MARK:
gc_finalize ();
case FINALIZE:
gc_sweep ();
case SWEEP:
gc_finish ();
case FINISH_GC:
break;
}
}
void gc (int incremental)
{
if (gc_currently_forbidden
|| in_display
|| preparing_for_armageddon)
return;
/* Very important to prevent GC during any of the following
stuff that might run Lisp code; otherwise, we'll likely
have infinite GC recursion. */
speccount = begin_gc_forbidden ();
gc_1 (incremental);
/* now stop inhibiting GC */
unbind_to (speccount);
}
void
gc_full (void)
{
gc (0);
}
DEFUN ("gc-full", Fgc_full, 0, 0, "", /*
This function performs a full garbage collection. If an incremental
garbage collection is already running, it completes without any
further interruption. This function guarantees that unused objects
are freed when it returns. Garbage collection happens automatically if
the client allocates more than `gc-cons-threshold' bytes of Lisp data
since the previous garbage collection.
*/
())
{
gc_full ();
return Qt;
}
void
gc_incremental (void)
{
gc (allow_incremental_gc);
}
DEFUN ("gc-incremental", Fgc_incremental, 0, 0, "", /*
This function starts an incremental garbage collection. If an
incremental garbage collection is already running, the next cycle
starts. Note that this function has not necessarily freed any memory
when it returns. This function only guarantees, that the traversal of
the heap makes progress. The next cycle of incremental garbage
collection happens automatically if the client allocates more than
`gc-incremental-cons-threshold' bytes of Lisp data since previous
garbage collection.
*/
())
{
gc_incremental ();
return Qt;
}
#else /* not NEW_GC */
void garbage_collect_1 (void)
{
if (gc_in_progress
|| gc_currently_forbidden
|| in_display
|| preparing_for_armageddon)
return;
/* Very important to prevent GC during any of the following
stuff that might run Lisp code; otherwise, we'll likely
have infinite GC recursion. */
speccount = begin_gc_forbidden ();
gc_prepare ();
#ifdef USE_KKCC
kkcc_gc_stack_init();
#ifdef DEBUG_XEMACS
kkcc_bt_init ();
#endif
#endif /* USE_KKCC */
gc_mark_root_set ();
#ifdef USE_KKCC
kkcc_marking (0);
#endif /* USE_KKCC */
gc_finish_mark ();
#ifdef USE_KKCC
kkcc_gc_stack_free ();
#ifdef DEBUG_XEMACS
kkcc_bt_free ();
#endif
#endif /* USE_KKCC */
gc_sweep_1 ();
gc_finish ();
/* now stop inhibiting GC */
unbind_to (speccount);
}
#endif /* not NEW_GC */
/************************************************************************/
/* Initializations */
/************************************************************************/
/* Initialization */
static void
common_init_gc_early (void)
{
Vgc_message = Qzero;
gc_currently_forbidden = 0;
gc_hooks_inhibited = 0;
need_to_garbage_collect = always_gc;
gc_cons_threshold = GC_CONS_THRESHOLD;
gc_cons_percentage = 40; /* #### what is optimal? */
total_gc_usage_set = 0;
#ifdef NEW_GC
gc_cons_incremental_threshold = GC_CONS_INCREMENTAL_THRESHOLD;
gc_incremental_traversal_threshold = GC_INCREMENTAL_TRAVERSAL_THRESHOLD;
#endif /* not NEW_GC */
}
void
init_gc_early (void)
{
}
void
reinit_gc_early (void)
{
common_init_gc_early ();
}
void
init_gc_once_early (void)
{
common_init_gc_early ();
}
void
syms_of_gc (void)
{
DEFSYMBOL (Qpre_gc_hook);
DEFSYMBOL (Qpost_gc_hook);
#ifdef NEW_GC
DEFSUBR (Fgc_full);
DEFSUBR (Fgc_incremental);
#ifdef ERROR_CHECK_GC
DEFSUBR (Fgc_stats);
#endif /* not ERROR_CHECK_GC */
#endif /* NEW_GC */
}
void
vars_of_gc (void)
{
staticpro_nodump (&pre_gc_cursor);
QSin_garbage_collection = build_msg_string ("(in garbage collection)");
staticpro (&QSin_garbage_collection);
DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold /*
*Number of bytes of consing between full garbage collections.
\"Consing\" is a misnomer in that this actually counts allocation
of all different kinds of objects, not just conses.
Garbage collection can happen automatically once this many bytes have been
allocated since the last garbage collection. All data types count.
Garbage collection happens automatically when `eval' or `funcall' are
called. (Note that `funcall' is called implicitly as part of evaluation.)
By binding this temporarily to a large number, you can effectively
prevent garbage collection during a part of the program.
Normally, you cannot set this value less than 10,000 (if you do, it is
automatically reset during the next garbage collection). However, if
XEmacs was compiled with DEBUG_XEMACS, this does not happen, allowing
you to set this value very low to track down problems with insufficient
GCPRO'ing. If you set this to a negative number, garbage collection will
happen at *EVERY* call to `eval' or `funcall'. This is an extremely
effective way to check GCPRO problems, but be warned that your XEmacs
will be unusable! You almost certainly won't have the patience to wait
long enough to be able to set it back.
See also `consing-since-gc' and `gc-cons-percentage'.
*/ );
DEFVAR_INT ("gc-cons-percentage", &gc_cons_percentage /*
*Percentage of memory allocated between garbage collections.
Garbage collection will happen if this percentage of the total amount of
memory used for data (see `lisp-object-memory-usage') has been allocated
since the last garbage collection. However, it will not happen if less
than `gc-cons-threshold' bytes have been allocated -- this sets an absolute
minimum in case very little data has been allocated or the percentage is
set very low. Set this to 0 to have garbage collection always happen after
`gc-cons-threshold' bytes have been allocated, regardless of current memory
usage.
See also `consing-since-gc' and `gc-cons-threshold'.
*/ );
#ifdef NEW_GC
DEFVAR_INT ("gc-cons-incremental-threshold",
&gc_cons_incremental_threshold /*
*Number of bytes of consing between cycles of incremental garbage
collections. \"Consing\" is a misnomer in that this actually counts
allocation of all different kinds of objects, not just conses. The
next garbage collection cycle can happen automatically once this many
bytes have been allocated since the last garbage collection cycle.
All data types count.
See also `gc-cons-threshold'.
*/ );
DEFVAR_INT ("gc-incremental-traversal-threshold",
&gc_incremental_traversal_threshold /*
*Number of elements processed in one cycle of incremental travesal.
*/ );
#endif /* NEW_GC */
DEFVAR_BOOL ("purify-flag", &purify_flag /*
Non-nil means loading Lisp code in order to dump an executable.
This means that certain objects should be allocated in readonly space.
*/ );
DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages /*
Non-nil means display messages at start and end of garbage collection.
*/ );
garbage_collection_messages = 0;
DEFVAR_LISP ("pre-gc-hook", &Vpre_gc_hook /*
Function or functions to be run just before each garbage collection.
Interrupts, garbage collection, and errors are inhibited while this hook
runs, so be extremely careful in what you add here. In particular, avoid
consing, and do not interact with the user.
*/ );
Vpre_gc_hook = Qnil;
DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook /*
Function or functions to be run just after each garbage collection.
Interrupts, garbage collection, and errors are inhibited while this hook
runs. Each hook is called with one argument which is an alist with
finalization data.
*/ );
Vpost_gc_hook = Qnil;
DEFVAR_LISP ("gc-message", &Vgc_message /*
String to print to indicate that a garbage collection is in progress.
This is printed in the echo area. If the selected frame is on a
window system and `gc-pointer-glyph' specifies a value (i.e. a pointer
image instance) in the domain of the selected frame, the mouse pointer
will change instead of this message being printed.
*/ );
Vgc_message = build_string (gc_default_message);
DEFVAR_LISP ("gc-pointer-glyph", &Vgc_pointer_glyph /*
Pointer glyph used to indicate that a garbage collection is in progress.
If the selected window is on a window system and this glyph specifies a
value (i.e. a pointer image instance) in the domain of the selected
window, the pointer will be changed as specified during garbage collection.
Otherwise, a message will be printed in the echo area, as controlled
by `gc-message'.
*/ );
#ifdef NEW_GC
DEFVAR_BOOL ("allow-incremental-gc", &allow_incremental_gc /*
*Non-nil means to allow incremental garbage collection. Nil prevents
*incremental garbage collection, the garbage collector then only does
*full collects (even if (gc-incremental) is called).
*/ );
#endif /* NEW_GC */
}
void
complex_vars_of_gc (void)
{
Vgc_pointer_glyph = Fmake_glyph_internal (Qpointer);
}
1.1 XEmacs/xemacs/src/gc.h
Index: gc.h
===================================================================
/* New incremental garbage collector 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_gc_h_
#define INCLUDED_gc_h_
BEGIN_C_DECLS
#ifdef NEW_GC
/************************************************************************/
/* Incremental Statistics */
/************************************************************************/
#ifdef ERROR_CHECK_GC
void gc_stat_print_stats (void);
void gc_stat_finalized (void);
void gc_stat_freed (void);
void gc_stat_explicitly_freed (void);
void gc_stat_explicitly_tried_freed (void);
# define GC_STAT_FINALIZED gc_stat_finalized ()
# define GC_STAT_FREED gc_stat_freed ()
# define GC_STAT_EXPLICITLY_FREED gc_stat_explicitly_freed ()
# define GC_STAT_EXPLICITLY_TRIED_FREED gc_stat_explicitly_tried_freed ()
#else /* not ERROR_CHECK_GC */
# define GC_STAT_FINALIZED
# define GC_STAT_FREED
# define GC_STAT_EXPLICITLY_FREED
# define GC_STAT_EXPLICITLY_TRIED_FREED
#endif /* not ERROR_CHECK_GC */
#endif /* not NEW_GC */
/************************************************************************/
/* Global Variables */
/************************************************************************/
/* Number of bytes of consing done since the last GC. */
extern EMACS_INT consing_since_gc;
/* Number of bytes of consing done since startup. */
extern EMACS_UINT total_consing;
/* Number of bytes of current allocated heap objects. */
extern EMACS_INT total_gc_usage;
/* If the above is set. */
extern int total_gc_usage_set;
/* Number of bytes of consing since gc before another gc should be done. */
extern EMACS_INT gc_cons_threshold;
/* Percentage of consing of total data size before another GC. */
extern EMACS_INT gc_cons_percentage;
#ifdef NEW_GC
/* Number of bytes of consing since gc before another cycle of the gc
should be done in incremental mode. */
extern EMACS_INT gc_cons_incremental_threshold;
/* Nonzero during gc */
extern int gc_in_progress;
/* Nonzero during write barrier */
extern int write_barrier_enabled;
/* Enable/disable incremental garbage collection during runtime. */
extern int allow_incremental_gc;
#endif /* NEW_GC */
/************************************************************************/
/* Prototypes */
/************************************************************************/
#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 */
#ifdef ERROR_CHECK_GC
#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
#define GC_CHECK_LHEADER_INVARIANTS(lheader)
#endif
void recompute_need_to_garbage_collect (void);
/* KKCC mark algorithm. */
#ifdef DEBUG_XEMACS
void kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos);
#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \
kkcc_gc_stack_push_lisp_object_1 (obj, level, pos)
void kkcc_gc_stack_repush_dirty_object_1 (Lisp_Object obj, int level, int pos);
#define kkcc_gc_stack_repush_dirty_object(obj) \
kkcc_gc_stack_repush_dirty_object_1 (obj, 0, -2)
void kkcc_backtrace (void);
#else
void kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj);
#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \
kkcc_gc_stack_push_lisp_object_1 (obj)
void kkcc_gc_stack_repush_dirty_object_1 (Lisp_Object obj);
#define kkcc_gc_stack_repush_dirty_object(obj) \
kkcc_gc_stack_repush_dirty_object_1 (obj)
#define kkcc_backtrace()
#endif
#ifdef NEW_GC
/* Repush objects that are caught by the write barrier. */
#define gc_write_barrier(obj) kkcc_gc_stack_repush_dirty_object (obj);
/* GC functions: */
/* Perform a full garbage collection without interruption. If an
incremental garbage collection is already running it is completed
without further interruption. This function calls gc() with a
negative or zero argument. */
void gc_full (void);
/* This function starts an incremental garbage collection. If an
incremental garbage collection is already running, the next cycle
of traversal work is done, or the garbage collection is completed
when no more traversal work has to be done. This function calls gc
with a positive argument, indicating how many objects can be
traversed in this cycle. */
void gc_incremental (void);
#endif /* NEW_GC */
/* Initializers */
void init_gc_early (void);
void reinit_gc_early (void);
void init_gc_once_early (void);
void syms_of_gc (void);
void vars_of_gc (void);
void complex_vars_of_gc (void);
#ifndef NEW_GC
/* Needed prototypes due to the garbage collector code move from
alloc.c to gc.c. */
void gc_sweep_1 (void);
#ifndef MC_ALLOC
extern void *breathing_space;
#endif /* not MC_ALLOC */
#endif /* not NEW_GC */
END_C_DECLS
#endif /* INCLUDED_gc_h_ */
1.1 XEmacs/xemacs/src/vdb-fake.c
Index: vdb-fake.c
===================================================================
/* Virtual diry bit implementation 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"
void
fake_error (void)
{
fprintf (stderr, "Incremental garbage collection not yet available on this");
fprintf (stderr, "system.\nDon't try to set allow-incremental-gc to t.\n");
ABORT ();
}
void
vdb_install_signal_handler (void)
{
allow_incremental_gc = 0;
}
void
vdb_protect (void *UNUSED (ptr), EMACS_INT UNUSED (len))
{
fake_error ();
}
void
vdb_unprotect (void *UNUSED (ptr), EMACS_INT UNUSED (len))
{
fake_error ();
}
1.1 XEmacs/xemacs/src/vdb-mach.c
Index: vdb-mach.c
===================================================================
/* Virtual diry bit implementation 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 "gc.h"
#include "mc-alloc.h"
#include "vdb.h"
#include <errno.h>
#include <signal.h>
#include <sys/mman.h>
#include <sys/time.h>
#include <sys/resource.h>
#include <unistd.h>
#include <mach/mach.h>
#include <mach/mach_error.h>
#include <architecture/ppc/cframe.h>
/* the structure of an exception msg and its reply */
typedef struct rep_msg {
mach_msg_header_t head;
NDR_record_t NDR;
kern_return_t ret_code;
} mach_reply_msg_t;
typedef struct exc_msg {
mach_msg_header_t head;
/* start of the kernel processed data */
mach_msg_body_t msgh_body;
mach_msg_port_descriptor_t thread;
mach_msg_port_descriptor_t task;
/* end of the kernel processed data */
NDR_record_t NDR;
exception_type_t exception;
mach_msg_type_number_t code_cnt;
exception_data_t code;
/* some padding */
char pad[512];
} mach_exc_msg_t;
/* this is a neat little mach callback */
extern boolean_t exc_server(mach_msg_header_t *in, mach_msg_header_t *out);
/* these are the globals everyone needs */
static size_t page_size = 16384;
static mach_port_t task_self = NULL;
static mach_port_t exc_port = NULL;
/* these are some less neat mach callbacks */
kern_return_t
catch_exception_raise_state
(mach_port_t UNUSED (port),
exception_type_t UNUSED (exception_type),
exception_data_t UNUSED (exception_data),
mach_msg_type_number_t UNUSED (data_cnt),
thread_state_flavor_t *UNUSED (flavor),
thread_state_t UNUSED (in_state),
mach_msg_type_number_t UNUSED (is_cnt),
thread_state_t UNUSED (out_state),
mach_msg_type_number_t UNUSED (os_cnt))
{
return KERN_FAILURE;
}
kern_return_t
catch_exception_raise_state_identitity
(mach_port_t UNUSED (port),
mach_port_t UNUSED (thread_port),
mach_port_t UNUSED (task_port),
exception_type_t UNUSED (exception_type),
exception_data_t UNUSED (exception_data),
mach_msg_type_number_t UNUSED (data_count),
thread_state_flavor_t *UNUSED (state_flavor),
thread_state_t UNUSED (in_state),
mach_msg_type_number_t UNUSED (in_state_count),
thread_state_t UNUSED (out_state),
mach_msg_type_number_t UNUSED (out_state_count))
{
return KERN_FAILURE;
}
kern_return_t
catch_exception_raise
(mach_port_t UNUSED (port),
mach_port_t UNUSED (thread_port),
mach_port_t UNUSED (task_port),
exception_type_t UNUSED (exception_type),
exception_data_t exception_data,
mach_msg_type_number_t UNUSED (data_count))
{
/* kernel return value is in exception_data[0], faulting address in
exception_data[1] */
if (write_barrier_enabled
&& (fault_on_protected_page ((void *) exception_data[1]))
&& exception_data[0] == KERN_PROTECTION_FAILURE)
{
vdb_designate_modified ((void *) exception_data[1]);
unprotect_page_and_mark_dirty ((void *) exception_data[1]);
return KERN_SUCCESS;
}
else /* default sigsegv handler */
{
fprintf (stderr, "\n\nFatal Error: Received %s (%d) for address 0x%x\n",
"EXC_BAD_ACCESS", exception_data[0], (int) exception_data[1]);
return KERN_FAILURE;
}
}
/* this is the thread which forwards of exceptions read from the exception
server off to our exception catchers and then back out to the other
thread */
void
exception_thread(void)
{
mach_msg_header_t *message;
mach_msg_header_t *reply;
kern_return_t retval;
/* allocate the space for the message and reply */
message = (mach_msg_header_t *) malloc (sizeof (mach_exc_msg_t));
reply = (mach_msg_header_t *) malloc (sizeof (mach_reply_msg_t));
/* do this loop forever */
while (1)
{
/* block until we get an exception message */
retval = mach_msg (message, MACH_RCV_MSG, 0, sizeof (mach_exc_msg_t),
exc_port, MACH_MSG_TIMEOUT_NONE, MACH_PORT_NULL);
/* forward off the handling of this message */
if (!exc_server (message, reply))
{
fprintf (stderr, "INTERNAL ERROR: exc_server() failed.\n");
ABORT ();
}
/* send the message back out to the thread */
retval = mach_msg (reply, MACH_SEND_MSG, sizeof (mach_reply_msg_t), 0,
MACH_PORT_NULL, MACH_MSG_TIMEOUT_NONE,
MACH_PORT_NULL);
}
}
/* this initializes the subsystem (sets the exception port, starts the
exception handling thread, etc) */
void
vdb_install_signal_handler (void)
{
mach_port_t thread_self, exc_port_s, exc_thread;
ppc_thread_state_t *exc_thread_state;
mach_msg_type_name_t type;
void *subthread_stack;
kern_return_t retval;
/* get ids for ourself */
if (!task_self)
task_self = mach_task_self ();
thread_self = mach_thread_self ();
/* allocate the port we're going to get exceptions on */
retval = mach_port_allocate (task_self, MACH_PORT_RIGHT_RECEIVE, &exc_port);
if (retval != KERN_SUCCESS)
{
fprintf (stderr, "Couldn't allocate exception port: %s\n",
mach_error_string (retval));
ABORT ();
}
/* extract out the send rights for that port, which the OS needs */
retval = mach_port_extract_right (task_self, exc_port,
MACH_MSG_TYPE_MAKE_SEND,
&exc_port_s, &type);
if(retval != KERN_SUCCESS)
{
fprintf (stderr, "Couldn't extract send rights: %s\n",
mach_error_string (retval));
ABORT ();
}
/* set the exception ports for this thread to the above */
retval = thread_set_exception_ports(thread_self, EXC_MASK_BAD_ACCESS,
exc_port_s, EXCEPTION_DEFAULT,
PPC_THREAD_STATE);
if(retval != KERN_SUCCESS)
{
fprintf (stderr, "Couldn't set exception ports: %s\n",
mach_error_string (retval));
ABORT ();
}
/* set up the subthread */
retval = thread_create(task_self, &exc_thread);
if(retval != KERN_SUCCESS)
{
fprintf (stderr , "Couldn't create exception thread: %s\n",
mach_error_string (retval));
ABORT ();
}
subthread_stack = (void *) malloc (page_size);
subthread_stack =
(char *) subthread_stack + (page_size - C_ARGSAVE_LEN - C_RED_ZONE);
exc_thread_state =
(ppc_thread_state_t *) malloc (sizeof (ppc_thread_state_t));
exc_thread_state->srr0 = (unsigned int) exception_thread;
exc_thread_state->r1 = (unsigned int) subthread_stack;
retval = thread_set_state (exc_thread, PPC_THREAD_STATE,
(thread_state_t) exc_thread_state,
PPC_THREAD_STATE_COUNT);
if (retval != KERN_SUCCESS)
{
fprintf (stderr, "Couldn't set subthread state: %s\n",
mach_error_string (retval));
ABORT ();
}
retval = thread_resume (exc_thread);
if (retval != KERN_SUCCESS)
{
fprintf (stderr, "Couldn't resume subthread: %s\n",
mach_error_string (retval));
ABORT ();
}
allow_incremental_gc = 1;
}
void
vdb_protect (void *ptr, EMACS_INT len)
{
if (mprotect (ptr, len, PROT_READ))
{
perror ("Couldn't mprotect");
ABORT ();
}
}
void
vdb_unprotect (void *ptr, EMACS_INT len)
{
if (mprotect (ptr, len, PROT_READ | PROT_WRITE))
{
perror ("Couldn't mprotect");
ABORT ();
}
}
1.1 XEmacs/xemacs/src/vdb-posix.c
Index: vdb-posix.c
===================================================================
/* Virtual diry bit implementation 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 "gc.h"
#include "mc-alloc.h"
#include "vdb.h"
#include <errno.h>
#include <signal.h>
#include <sys/mman.h>
#if defined (HAVE_SIGACTION)
# if defined (HAVE_STRUCT_SIGINFO_SI_ADDR)
# define FAULT_HANDLER_ARGUMENTS \
int signum, struct siginfo *siginfo, void *UNUSED (ctx)
# define GET_FAULT_ADDRESS siginfo->si_addr
# elif defined (HAVE_SIGINFO_T_SI_ADDR)
# define FAULT_HANDLER_ARGUMENTS \
int signum, siginfo_t *siginfo, void *UNUSED (ctx)
# define GET_FAULT_ADDRESS siginfo->si_addr
# endif
# define USE_SIGACTION
# define FAULT_HANDLER_REMOVE_HANDLER
#elif defined (HAVE_SIGNAL)
# define FAULT_HANDLER_ARGUMENTS int signum, struct sigcontext sc
# define GET_FAULT_ADDRESS (void *) sc.cr2
# define USE_SIGNAL
#endif
#ifdef USE_SIGACTION
struct sigaction act, segv_oact, bus_oact;
#endif /* USE_SIGACTION */
#ifdef USE_SIGNAL
sighandler_t segv_oact, bus_oact;
#endif /* USE_SIGNAL */
void vdb_remove_signal_handler (void);
void
vdb_fault_handler (FAULT_HANDLER_ARGUMENTS)
{
if (write_barrier_enabled
&& (fault_on_protected_page (GET_FAULT_ADDRESS)))
{
vdb_designate_modified (GET_FAULT_ADDRESS);
unprotect_page_and_mark_dirty (GET_FAULT_ADDRESS);
#ifdef FAULT_HANDLER_REINSTALL_HANDLER
vdb_install_signal_handler ();
#endif /* FAULT_HANDLER_REINSTALL_HANDLER */
}
else /* default sigsegv handler */
{
char *signal_name;
if (signum == SIGSEGV)
signal_name = "SIGSEGV";
else if (signum == SIGBUS)
signal_name = "SIGBUS";
else
ABORT (); /* something weird happened: wrong signal caught */
fprintf (stderr, "\n\nFatal Error: Received %s (%d) for address 0x%x\n",
signal_name, signum, (int) GET_FAULT_ADDRESS);
#ifdef FAULT_HANDLER_CALL_PREVIOUS_HANDLER
if (signum == SIGSEGV)
segv_oact (signum);
else if (signum == SIGBUS)
bus_oact (signum);
#endif /* FAULT_HANDLER_CALL_PREVIOUS_HANDLER */
#ifdef FAULT_HANDLER_REMOVE_HANDLER
vdb_remove_signal_handler ();
#endif /* FAULT_HANDLER_REMOVE_HANDLER */
}
}
void
vdb_remove_signal_handler (void)
{
#ifdef USE_SIGACTION
sigaction(SIGSEGV, &segv_oact, 0);
sigaction(SIGBUS, &bus_oact, 0);
#endif /* USE_SIGACTION */
#ifdef USE_SIGNAL
signal (SIGSEGV, segv_oact);
signal (SIGBUS, bus_oact);
#endif
}
void
vdb_install_signal_handler (void)
{
/* See init_signals_very_early () in signal.c. */
if (noninteractive && !initialized)
{
allow_incremental_gc = 0;
return;
}
#ifdef USE_SIGACTION
memset(&act, sizeof(struct sigaction), 0);
act.sa_sigaction = vdb_fault_handler;
sigemptyset (&act.sa_mask);
act.sa_flags = SA_SIGINFO;
sigaction (SIGSEGV, &act, &segv_oact);
sigaction (SIGBUS, &act, &bus_oact);
allow_incremental_gc = 1;
#endif /* USE_SIGACTION */
#ifdef USE_SIGNAL
segv_oact = signal (SIGSEGV, (void (*)(int)) vdb_fault_handler);
bus_oact = signal (SIGBUS, (void (*)(int)) vdb_fault_handler);
#endif /* USE_SIGNAL */
}
void
vdb_protect (void *ptr, EMACS_INT len)
{
if (mprotect (ptr, len, PROT_READ))
{
perror ("Couldn't mprotect");
ABORT ();
}
}
void
vdb_unprotect (void *ptr, EMACS_INT len)
{
if (mprotect (ptr, len, PROT_READ | PROT_WRITE))
{
perror ("Couldn't mprotect");
ABORT ();
}
}
1.1 XEmacs/xemacs/src/vdb-win32.c
Index: vdb-win32.c
===================================================================
/* Virtual diry bit implementation 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 "gc.h"
#include "mc-alloc.h"
#include "vdb.h"
#include "syswindows.h"
DWORD WINAPI
win32_fault_handler (LPEXCEPTION_POINTERS e)
{
#define GET_FAULT_ADDRESS (void *) e->ExceptionRecord->ExceptionInformation[1]
if ((e->ExceptionRecord->ExceptionCode == EXCEPTION_ACCESS_VIOLATION)
&& (e->ExceptionRecord->ExceptionInformation[0] == 1)
&& write_barrier_enabled
&& (fault_on_protected_page (GET_FAULT_ADDRESS)))
{
vdb_designate_modified (GET_FAULT_ADDRESS);
unprotect_page_and_mark_dirty (GET_FAULT_ADDRESS);
return EXCEPTION_CONTINUE_EXECUTION;
}
else
return EXCEPTION_CONTINUE_SEARCH;
}
typedef DWORD (WINAPI *gcPVECTORED_EXCEPTION_HANDLER) (LPEXCEPTION_POINTERS e);
void
vdb_install_signal_handler (void)
{
HMODULE hm;
PVOID (WINAPI *aveh) (ULONG, gcPVECTORED_EXCEPTION_HANDLER);
/* See init_signals_very_early () in signal.c. */
if (noninteractive && !initialized)
{
allow_incremental_gc = 0;
return;
}
hm = qxeGetModuleHandle (XETEXT ("kernel32"));
if (hm)
aveh = (PVOID (WINAPI *) (ULONG, gcPVECTORED_EXCEPTION_HANDLER))
GetProcAddress (hm, "AddVectoredExceptionHandler");
else
{
fprintf (stderr, "\nFAILED TO LOAD LIBRARY\n");
aveh = NULL;
}
if (aveh)
{
allow_incremental_gc = 1;
aveh (TRUE, win32_fault_handler);
}
else
{
fprintf (stderr, "\nFAILED TO INSTALL SIGNAL HANDLER\n");
ABORT ();
}
}
void
vdb_protect (void *ptr, EMACS_INT len)
{
DWORD old;
VirtualProtect (ptr, len, PAGE_READONLY, &old);
}
void
vdb_unprotect (void *ptr, EMACS_INT len)
{
DWORD old;
VirtualProtect (ptr, len, PAGE_READWRITE, &old);
}
1.1 XEmacs/xemacs/src/vdb.c
Index: vdb.c
===================================================================
/* Virtual diry bit implementation (platform independent) 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 "gc.h"
#include "mc-alloc.h"
#include "vdb.h"
typedef struct
{
Dynarr_declare (void *);
} void_ptr_dynarr;
void_ptr_dynarr *page_fault_table;
/* Init page fault table and protect heap. */
void
vdb_start_dirty_bits_recording (void)
{
page_fault_table = Dynarr_new2 (void_ptr_dynarr, void *);
protect_heap_pages ();
}
/* Remove heap protection. */
void
vdb_stop_dirty_bits_recording (void)
{
unprotect_heap_pages ();
}
/* Read page fault table and pass page faults to garbage collector. */
int
vdb_read_dirty_bits (void)
{
int repushed_objects = 0;
Elemcount count;
for (count = Dynarr_length (page_fault_table); count; count--)
repushed_objects +=
repush_all_objects_on_page (Dynarr_at (page_fault_table, count - 1));
Dynarr_free (page_fault_table);
page_fault_table = 0;
return repushed_objects;
}
/* Called by the page fault handler: add address to page fault table. */
void
vdb_designate_modified (void *addr)
{
Dynarr_add (page_fault_table, addr);
}
/* For testing and debugging... */
DEFUN ("test-vdb", Ftest_vdb, 0, 0, "", /*
Test virtual dirty bit implementation. Prints results to stderr.
*/
())
{
Rawbyte *p;
char c;
Elemcount count;
/* Wrap up gc (if currently running). */
gc_full ();
/* Allocate a buffer; it will have the default
protection of PROT_READ|PROT_WRITE. */
p = (Rawbyte *) mc_alloc (mc_get_page_size());
set_lheader_implementation ((struct lrecord_header *) p, &lrecord_cons);
fprintf (stderr, "Allocate p: [%x ... %x], length %d\n",
(int) p, (int) (p + mc_get_page_size ()),
(int) mc_get_page_size ());
/* Test read. */
fprintf (stderr, "Attempt to read p[666]... ");
c = p[666];
fprintf (stderr, "read ok.\n");
/* Test write. */
fprintf (stderr, "Attempt to write 42 to p[666]... ");
p[666] = 42;
fprintf (stderr, "write ok, p[666] = %d\n", p[666]);
/* Mark the buffer read-only and set environemnt for write-barrier. */
fprintf (stderr, "Write-protect the page.\n");
MARK_BLACK (p);
vdb_start_dirty_bits_recording ();
write_barrier_enabled = 1;
/* Test write-barrier read. */
fprintf (stderr, "Attempt to read p[666]... ");
c = p[666];
fprintf (stderr, "read ok.\n");
/* Test write-barrier write, program receives SIGSEGV. */
fprintf (stderr, "Attempt to write 23 to p[666]... ");
p[666] = 23;
fprintf (stderr, "Written p[666] = %d\n", p[666]);
/* Stop write-barrier mode. */
write_barrier_enabled = 0;
MARK_WHITE (p);
vdb_unprotect (p, mc_get_page_size ());
for (count = Dynarr_length (page_fault_table); count; count--)
if (Dynarr_at (page_fault_table, count - 1) == &p[666])
fprintf (stderr, "VALID page fault at %x\n",
(int) Dynarr_at (page_fault_table, count - 1));
else
fprintf (stderr, "WRONG page fault at %x\n",
(int) Dynarr_at (page_fault_table, count - 1));
Dynarr_free (page_fault_table);
mc_free (p);
return Qnil;
}
DEFUN ("test-segfault", Ftest_segfault, 0, 0, "", /*
Test virtual dirty bit implementation: provoke a segfault on purpose.
WARNING: this function causes a SEGFAULT on purpose and thus crashes
XEmacs! This is only used for debbugging, e.g. for testing how the
debugger behaves when XEmacs segfaults and the write barrier is
enabled.
*/
())
{
Rawbyte *q = 0;
q[0] = 23;
return Qnil;
}
void
syms_of_vdb (void)
{
DEFSUBR (Ftest_vdb);
DEFSUBR (Ftest_segfault);
}
1.1 XEmacs/xemacs/src/vdb.h
Index: vdb.h
===================================================================
/* Virtual diry bit implementation 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 "lisp.h"
#ifndef INCLUDED_vdb_h_
#define INCLUDED_vdb_h_
/*--- prototypes -------------------------------------------------------*/
BEGIN_C_DECLS
/* Platform dependent signal handling: */
/* Install the platform-dependent signal handler. */
void vdb_install_signal_handler (void);
/* Platform dependent memory protection. */
void vdb_protect (void *ptr, EMACS_INT len);
void vdb_unprotect (void *ptr, EMACS_INT len);
/* Common (platform independent) virtual diry bit stuff: */
/* Start the write barrier. This function is called when a garbage
collection is suspendend and the client is resumed. */
void vdb_start_dirty_bits_recording (void);
/* Stop the write barrier. This function is called when the client is
suspendend and garbage collection is resumed. */
void vdb_stop_dirty_bits_recording (void);
/* Record page faults: Add the object pointed to by addr to the write
barrer's internal data structure that stores modified objects.
This function is called by the write barrier's fault handler. */
void vdb_designate_modified (void *addr);
/* Propagate page faults to garbage collector: Read out the write
barrier's internal data structure that stores modified objects and
pass the information to the garbage collector. This function is
called by vdb_stop_dirty_bits_recording(). Return how many objects
have to be re-examined by the garbage collector. */
int vdb_read_dirty_bits (void);
/* Provides Lisp functions for testing vdb implementation. */
void syms_of_vdb (void);
END_C_DECLS
#endif /* INCLUDED_vdb_h_ */
- 1 participants
- 0 comments