Permalink
Browse files

0.6.12.7.flaky1:

	(This system state is seriously screwed up. It did build,
		both on Linux and on OpenBSD, but signalled an
		error after writing out sbcl.core on OpenBSD, and
		although it runs a little both on Linux and on
		OpenBSD, it hangs in the regression tests. It
		also has some temporary hacks marked REMOVEME,
		including one which suppresses PURIFY when
		building the system (!).)
	made the system build on OpenBSD again..
	..stubbed stuff out as a quick fix to the problem of FFI to
		64-bit stat.st_size
	tried to make the system run on OpenBSD again..
	..initialized current_dynamic_space, since it's now used
		instead of DYNAMIC_SPACE_START in PURIFY
	..added new assertions about GENCGC alloc_region stuff being
		reset when it should be
	renamed Lisp-level struct stat stuff to struct wrapped_stat
	tried to tidy up Lisp-level stat stuff; removed mysterious
		(STRING= NAME "") behavior from UNIX-STAT
	added slam.sh to help in low-level compile-and-try cycle
	pulled alloc_region-is-reset logic out into separate
		functions, and added more assertions on it (hunting
		for a bug which broke the old assertions)
	renamed gc_alloc_large to gc_alloc_possibly_large, and
		gc_quick_alloc_large_unboxed to
		gc_quick_alloc_unboxed_possibly_large
	enabled various GC checks, e.g. gencgc_zero_check=1
	deleted unused (and bizarre..) gencgc_verify_zero_fill()
	turned off PURIFY in order to get the system to build, since
		PURIFY seems to be misbehaving (leaving INIT-FUNCTION
		above the cutoff address..)
  • Loading branch information...
1 parent f2aa2d0 commit d7f6139a91d7d9b0667a597584ae306d958bb2f4 William Harold Newman committed May 15, 2001
View
4 NEWS
@@ -736,7 +736,9 @@ changes in sbcl-0.6.12 relative to sbcl-0.6.11:
support for (AND ..) types, among other things)
changes in sbcl-0.6.13 relative to sbcl-0.6.12:
-* The system has now been ported to the Alpha CPU, thanks to Dan Barlow.
+* a port to the Alpha CPU, thanks to Dan Barlow
+* better error handling in CLOS method combination, thanks to
+ Martin Atzmueller and Pierre Mai
planned incompatible changes in 0.7.x:
* The debugger prompt sequence now goes "5]", "5[2]", "5[3]", etc.
View
25 clean.sh
@@ -22,7 +22,15 @@ rm -rf obj/* output/* doc/user-manual \
# distribution, we automatically clean up after it here in the
# standard clean.sh file.)
-# Within other directories, remove things which don't look like source
+# Ask some other directories to clean themselves up.
+pwd=`pwd`
+for d in tools-for-build; do
+ cd $d
+ make clean
+ cd $pwd
+done
+
+# Within all directories, remove things which don't look like source
# files. Some explanations:
# (symlinks)
# are never in the sources; they must've been created
@@ -36,16 +44,29 @@ rm -rf obj/* output/* doc/user-manual \
# *.htm, *.html
# probably machine-generated translation of DocBook (*.sgml) files
# core
-# probably a core dump -- not part of the sources anyway
+# probably a Unix core dump -- not part of the sources anyway
+# *.o, *.lib, *.nm
+# results of C-style linking, assembling, etc.
+# *.core, *.map
+# looks like SBCL SAVE-LISP-AND-DIE or GENESIS output, and
+# certainly not source
# *~, #*#, TAGS
# common names for editor temporary files
+# *.htm, *.html
+# The system doc sources are SGML, any HTML is automatically
+# generated output.
+# depend
+# made by "make depend" (or "gmake depend" or some such thing)
+# *.x86f, *.axpf, *.lbytef, *.fasl
+# typical extensions for fasl files
find . \( \
-type l -or \
-name '*~' -or \
-name '#*#' -or \
-name '?*.x86f' -or \
-name '?*.axpf' -or \
-name '?*.lbytef' -or \
+ -name '?*.fasl' -or \
-name 'core' -or \
-name '?*.core' -or \
-name '*.map' -or \
View
5 make-config.sh
@@ -24,8 +24,8 @@ if [ ! -d output ] ; then mkdir output; fi
ltf=`pwd`/local-target-features.lisp-expr
echo //initializing $ltf
echo ';;;; This is a machine-generated file.' > $ltf
-echo ';;;; Please do not edit it by hand.' > $ltf
-echo ';;;; See make-config.sh.' > $ltf
+echo ';;;; Please do not edit it by hand.' >> $ltf
+echo ';;;; See make-config.sh.' >> $ltf
echo -n '(' >> $ltf
echo //guessing default target CPU architecture from host architecture
@@ -42,6 +42,7 @@ esac
echo //setting up CPU-architecture-dependent information
sbcl_arch=${SBCL_ARCH:-$guessed_sbcl_arch}
+echo sbcl_arch=\"$sbcl_arch\"
if [ "$sbcl_arch" = "" ] ; then
echo "can't guess target SBCL architecture, need SBCL_ARCH environment var"
exit 1
View
61 make-genesis-2.sh
@@ -0,0 +1,61 @@
+#!/bin/sh
+
+# This is a script to be run as part of make.sh. The only time you'd
+# want to run it by itself is if you're trying to cross-compile the
+# system or if you're doing some kind of troubleshooting.
+
+# This software is part of the SBCL system. See the README file for
+# more information.
+#
+# This software is derived from the CMU CL system, which was
+# written at Carnegie Mellon University and released into the
+# public domain. The software is in the public domain and is
+# provided with absolutely no warranty. See the COPYING and CREDITS
+# files for more information.
+
+echo //entering make-genesis-2.sh
+
+# In a fresh host Lisp invocation, load the cross-compiler (in order
+# to get various definitions that GENESIS needs, not in order to
+# cross-compile GENESIS, then load and run GENESIS. (We use a fresh
+# host Lisp invocation here for basically the same reasons we did
+# before when loading and running the cross-compiler.)
+#
+# (Why do we need this second invocation of GENESIS? In order to
+# create a .core file, as opposed to just a .h file, GENESIS needs
+# symbol table data on the C runtime. And we can get that symbol
+# data only after the C runtime has been built. Therefore, even
+# though we ran GENESIS earlier, we couldn't get it to make a .core
+# file at that time; but we needed to run it earlier in order to
+# get to where we can write a .core file.)
+echo //loading and running GENESIS to create cold-sbcl.core
+$SBCL_XC_HOST <<-'EOF' || exit 1
+ (setf *print-level* 5 *print-length* 5)
+ (load "src/cold/shared.lisp")
+ (in-package "SB-COLD")
+ (setf *host-obj-prefix* "obj/from-host/"
+ *target-obj-prefix* "obj/from-xc/")
+ (load "src/cold/set-up-cold-packages.lisp")
+ (load "src/cold/defun-load-or-cload-xcompiler.lisp")
+ (load-or-cload-xcompiler #'host-load-stem)
+ (defparameter *target-object-file-names*
+ (with-open-file (s "output/object-filenames-for-genesis.lisp-expr"
+ :direction :input)
+ (read s)))
+ (host-load-stem "src/compiler/generic/genesis")
+ (sb!vm:genesis :object-file-names *target-object-file-names*
+ :c-header-file-name "output/sbcl2.h"
+ :symbol-table-file-name "src/runtime/sbcl.nm"
+ :core-file-name "output/cold-sbcl.core"
+ ;; The map file is not needed by the system, but can
+ ;; be very handy when debugging cold init problems.
+ :map-file-name "output/cold-sbcl.map")
+ EOF
+
+echo //testing for consistency of first and second GENESIS passes
+if cmp src/runtime/sbcl.h output/sbcl2.h; then
+ echo //sbcl2.h matches sbcl.h -- good.
+else
+ echo error: sbcl2.h does not match sbcl.h.
+ exit 1
+fi
View
62 make-host-2.sh
@@ -15,6 +15,12 @@
echo //entering make-host-2.sh
+# In some cases, a debugging build of the system will creates a core
+# file output/after-xc.core in the next step. In cases where it
+# doesn't, it's confusing and basically useless to have any old copies
+# lying around, so delete:
+rm -f output/after-xc.core
+
# In a fresh host Lisp invocation, load and run the cross-compiler to
# create the target object files describing the target SBCL.
#
@@ -97,54 +103,14 @@ $SBCL_XC_HOST <<-'EOF' || exit 1
;; this can be a good time to run it. The resulting core isn't
;; used in the normal build, but can be handy for experimenting
;; with the system.
- (when (find :sb-show *shebang-features*)
+
+ ;; REMOVEME: should be conditional on :SB-SHOW again
+ ;;(when (find :sb-show *shebang-features*)
#+cmu (ext:save-lisp "output/after-xc.core" :load-init-file nil)
- #+sbcl (sb-ext:save-lisp-and-die "output/after-xc.core"))
- EOF
-
-# Run GENESIS again in order to create cold-sbcl.core.
-#
-# In a fresh host Lisp invocation, load the cross-compiler (in order
-# to get various definitions that GENESIS needs, not in order to
-# cross-compile GENESIS, then load and run GENESIS. (We use a fresh
-# host Lisp invocation here for basically the same reasons we did
-# before when loading and running the cross-compiler.)
-#
-# (Why do we need this second invocation of GENESIS? In order to
-# create a .core file, as opposed to just a .h file, GENESIS needs
-# symbol table data on the C runtime. And we can get that symbol
-# data only after the C runtime has been built. Therefore, even
-# though we ran GENESIS earlier, we couldn't get it to make a .core
-# file at that time; but we needed to run it earlier in order to
-# get to where we can write a .core file.)
-echo //loading and running GENESIS to create cold-sbcl.core
-$SBCL_XC_HOST <<-'EOF' || exit 1
- (setf *print-level* 5 *print-length* 5)
- (load "src/cold/shared.lisp")
- (in-package "SB-COLD")
- (setf *host-obj-prefix* "obj/from-host/"
- *target-obj-prefix* "obj/from-xc/")
- (load "src/cold/set-up-cold-packages.lisp")
- (load "src/cold/defun-load-or-cload-xcompiler.lisp")
- (load-or-cload-xcompiler #'host-load-stem)
- (defparameter *target-object-file-names*
- (with-open-file (s "output/object-filenames-for-genesis.lisp-expr"
- :direction :input)
- (read s)))
- (host-load-stem "src/compiler/generic/genesis")
- (sb!vm:genesis :object-file-names *target-object-file-names*
- :c-header-file-name "output/sbcl2.h"
- :symbol-table-file-name "src/runtime/sbcl.nm"
- :core-file-name "output/cold-sbcl.core"
- ;; The map file is not needed by the system, but can
- ;; be very handy when debugging cold init problems.
- :map-file-name "output/cold-sbcl.map")
+ #+sbcl (sb-ext:save-lisp-and-die "output/after-xc.core")
+ ;;)
EOF
-echo //testing for consistency of first and second GENESIS passes
-if cmp src/runtime/sbcl.h output/sbcl2.h; then
- echo //sbcl2.h matches sbcl.h -- good.
-else
- echo error: sbcl2.h does not match sbcl.h.
- exit 1
-fi
+# Run GENESIS (again) (The first time was before we ran the
+# cross-compiler.) in order to create cold-sbcl.core.
+sh make-genesis-2.sh
View
3 make-target-1.sh
@@ -34,8 +34,7 @@ $gnumake all || exit 1
cd ../..
# Use a little C program to grab stuff from the C header files and
-# smash it into Lisp source code, so that we won't get all stressed
-# and careworn like the CMU CL maintainers.
+# smash it into Lisp source code.
cd tools-for-build
$gnumake grovel_headers
cd ..
View
6 make-target-2.sh
@@ -46,6 +46,8 @@ echo //doing warm init
;; not wanted by default after build is complete. (And if it's
;; wanted, it can easily be turned back on.)
#+sb-show (setf sb-int:*/show* nil)
- (sb-ext:save-lisp-and-die "output/sbcl.core" :purify t)
-
+ ;; REMOVEME: This is supposed to be :PURIFY T, the :PURIFY NIL
+ ;; is a hopefully-very-short-lived workaround for a bug in
+ ;; sbcl-0.6.12.8.
+ (sb-ext:save-lisp-and-die "output/sbcl.core" :purify nil)
EOF
View
56 slam.sh
@@ -0,0 +1,56 @@
+#!/bin/sh
+
+# a quick and dirty way of partially rebuilding the system after a
+# change
+#
+# This script is not a reliable way to build the system, but it is
+# fast.:-| It can be useful if you are trying to debug a low-level
+# problem, e.g. a problem in src/runtime/*.c or in src/code/unix.lisp,
+# and you find yourself wanting to make a small change and test it
+# without going through the entire build-the-system-from-scratch
+# cycle.
+#
+# You probably don't want to be using this script unless you
+# understand the system build process to be able to guess when it
+# won't work.
+
+
+# This software is part of the SBCL system. See the README file for
+# more information.
+#
+# This software is derived from the CMU CL system, which was
+# written at Carnegie Mellon University and released into the
+# public domain. The software is in the public domain and is
+# provided with absolutely no warranty. See the COPYING and CREDITS
+# files for more information.
+
+
+export SBCL_XC_HOST="${1:-sbcl --noprogrammer}"
+
+# (We don't do make-host-1.sh at all. Hopefully nothing relevant has
+# changed.)
+
+sh make-target-1.sh || exit 1
+
+# Instead of doing the full make-host-2.sh, we (1) use after-xc.core
+# to rebuild only the specifically-requested Lisp files (or skip
+# after-xc.core completely if no Lisp files are specifically
+# requested), then (2) run GENESIS.
+#
+# Our command line arguments are the stems that we'll use
+# after-xc.core to recompile. If there are no command line arguments,
+# though, make a point of not calling after-xc.core, since it might
+# not exist, and there's no point in causing a fatal failure (by
+# unsuccessfully trying to execute it) unnecessarily.
+if [ "$*" != "" ] ; then
+ # Actually, I wrote this script when I needed to do a lot of
+ # tweaking in src/runtime/*.c, and I haven't tried to make it
+ # work for src/code/*.c yet. -- WHN 2001-05-12
+ echo stub: no support yet for after-xc.core
+ exit 1
+fi
+sh make-genesis-2.sh || exit 1
+
+sh make-target-2.sh || exit 1
+
+echo /ordinary termination of slam.sh
View
13 src/code/cold-init.lisp
@@ -85,6 +85,8 @@
(/show0 "entering !COLD-INIT")
+ (%primitive print "//entering !COLD-INIT") ; REMOVEME
+
;; FIXME: It'd probably be cleaner to have most of the stuff here
;; handled by calls like !GC-COLD-INIT, !ERROR-COLD-INIT, and
;; !UNIX-COLD-INIT. And *TYPE-SYSTEM-INITIALIZED* could be changed to
@@ -105,6 +107,8 @@
(setf *cold-init-complete-p* nil)
(setf *type-system-initialized* nil)
+ (%primitive print "//done with SETFs") ; REMOVEME
+
;; Anyone might call RANDOM to initialize a hash value or something;
;; and there's nothing which needs to be initialized in order for
;; this to be initialized, so we initialize it right away.
@@ -135,6 +139,8 @@
;; functions are called in the same relative order as the toplevel
;; forms of the corresponding source files.
+ (%primitive print "//about to !POLICY-COLD-INIT-OR-RESANIFY") ; REMOVEME
+
;;(show-and-call !package-cold-init)
(show-and-call !policy-cold-init-or-resanify)
(/show0 "back from !POLICY-COLD-INIT-OR-RESANIFY")
@@ -154,6 +160,8 @@
(/primitive-print hexstr)))
(let (#!+sb-show (index-in-cold-toplevels 0))
#!+sb-show (declare (type fixnum index-in-cold-toplevels))
+ (%primitive print "//about to DOLIST TOPLEVEL-THING") ; REMOVEME
+
(dolist (toplevel-thing (prog1
(nreverse *!reversed-cold-toplevels*)
;; (Now that we've NREVERSEd it, it's
@@ -194,6 +202,7 @@
(!cold-lose "bogus fixup code in *!REVERSED-COLD-TOPLEVELS*"))))
(t (!cold-lose "bogus function in *!REVERSED-COLD-TOPLEVELS*")))))
(/show0 "done with loop over cold toplevel forms and fixups")
+ (%primitive print "//done with DOLIST TOPLEVEL-THING") ; REMOVEME
;; Set sane values again, so that the user sees sane values instead
;; of whatever is left over from the last DECLAIM/PROCLAIM.
@@ -222,6 +231,7 @@
:invalid
:divide-by-zero))
+ (%primitive print "//about to !CLASS-FINALIZE") ; REMOVEME
(show-and-call !class-finalize)
;; The reader and printer are initialized very late, so that they
@@ -247,6 +257,7 @@
(/show0 "done initializing")
(setf *cold-init-complete-p* t)
+ (%primitive print "//set *COLD-INIT-COMPLETE-P*") ; REMOVEME
;; The system is finally ready for GC.
#!-gengc (setf *already-maybe-gcing* nil)
@@ -256,6 +267,8 @@
(gc :full t)
(/show0 "back from first GC")
+ (%primitive print "//back from first GC") ; REMOVEME
+
;; The show is on.
(terpri)
(/show0 "going into toplevel loop")
View
18 src/code/fd-stream.lisp
@@ -858,6 +858,12 @@
(:charpos
(fd-stream-char-pos fd-stream))
(:file-length
+ ;; FIXME: This is broken on OpenBSD until the FFI, or at least
+ ;; UNIX-FSTAT, learns to extract 64-bit values. (As of sbcl-0.6.12.8,
+ ;; UNIX-FSTAT returns a 0 placeholder instead.)
+ #!+openbsd
+ (error "FIXME: internal error, FILE-LENGTH is broken on OpenBSD")
+ #!-openbsd
(multiple-value-bind (okay dev ino mode nlink uid gid rdev size
atime mtime ctime blksize blocks)
(sb!unix:unix-fstat (fd-stream-fd fd-stream))
@@ -1124,8 +1130,8 @@
(delete-original (eq if-exists :rename-and-delete))
(mode #o666))
(when original
- ;; We are doing a :RENAME or :RENAME-AND-DELETE.
- ;; Determine whether the file already exists, make sure the original
+ ;; We are doing a :RENAME or :RENAME-AND-DELETE. Determine
+ ;; whether the file already exists, make sure the original
;; file is not a directory, and keep the mode.
(let ((exists
(and namestring
@@ -1154,10 +1160,10 @@
(do-old-rename namestring original))
(setf original nil)
(setf delete-original nil)
- ;; In order to use :SUPERSEDE instead, we have to make sure
- ;; SB!UNIX:O_CREAT corresponds to IF-DOES-NOT-EXIST.
- ;; SB!UNIX:O_CREAT was set before because of IF-EXISTS being
- ;; :RENAME.
+ ;; In order to use :SUPERSEDE instead, we have to make
+ ;; sure SB!UNIX:O_CREAT corresponds to
+ ;; IF-DOES-NOT-EXIST. SB!UNIX:O_CREAT was set before
+ ;; because of IF-EXISTS being :RENAME.
(unless (eq if-does-not-exist :create)
(setf mask
(logior (logandc2 mask sb!unix:o_creat)
View
12 src/code/load.lisp
@@ -273,15 +273,16 @@
(let* ((fhsss sb!c:*fasl-header-string-start-string*)
(fhsss-length (length fhsss)))
(unless (= byte (char-code (schar fhsss 0)))
- (error "illegal fasl file header: first byte"))
+ (error "illegal first byte in fasl file header"))
(do ((byte (read-byte stream) (read-byte stream))
(count 1 (1+ count)))
((= byte sb!c:*fasl-header-string-stop-char-code*)
t)
(declare (fixnum byte count))
(when (and (< count fhsss-length)
(not (eql byte (char-code (schar fhsss count)))))
- (error "illegal fasl file header: subsequent byte"))))
+ (error
+ "illegal subsequent (not first) byte in fasl file header"))))
;; Read and validate implementation and version, or die.
(let* ((implementation-length (read-arg 4))
@@ -379,8 +380,15 @@
;; don't. (CMU CL did, but implemented it in a non-ANSI way, and I
;; just disabled that instead of rewriting it.) -- WHN 20000131
(declare (ignore print))
+
+ ;; FIXME: In sbcl-0.6.12.8 the OpenBSD implementation of FILE-LENGTH
+ ;; broke because changed handling of Unix stat(2) stuff couldn't
+ ;; deal with OpenBSD's 64-bit size slot. Once that's fixed, this
+ ;; code can be restored.
+ #!-openbsd
(when (zerop (file-length stream))
(error "attempt to load an empty FASL file:~% ~S" (namestring stream)))
+
(do-load-verbose stream verbose)
(let* ((*fasl-file* stream)
(*current-fop-table* (or (pop *free-fop-tables*) (make-array 1000)))
View
32 src/code/save.lisp
@@ -33,22 +33,22 @@
(file sb!c-call:c-string)
(initial-function (sb!alien:unsigned #.sb!vm:word-bits)))
-;;; FIXME: When this is run without the PURIFY option,
-;;; it seems to save memory all the way up to the high-water mark,
-;;; not just what's currently used; and then after loading the
-;;; image to make a running Lisp, the memory never gets reclaimed.
-;;; (But with the PURIFY option it seems to work OK.)
+;;; FIXME: When this is run without the PURIFY option under GENCGC, it
+;;; seems to save memory all the way up to the high-water mark, not
+;;; just what's currently used; and then after loading the image to
+;;; make a running Lisp, the memory never gets reclaimed. (But with
+;;; the PURIFY option it seems to work OK.)
(defun save-lisp-and-die (core-file-name &key
(toplevel #'toplevel-init)
(purify nil)
(root-structures ())
(environment-name "auxiliary"))
#!+sb-doc
- "Saves a CMU Common Lisp core image in the file of the specified name,
+ "Save a CMU Common Lisp core image in the file of the specified name,
killing the current Lisp invocation in the process (unless it bails
out early because of some argument error or something).
- The following &KEY args are defined:
+ The following &KEY arguments are defined:
:TOPLEVEL
The function to run when the created core file is resumed.
@@ -57,10 +57,10 @@
function should not return.
:PURIFY
- If true (the default), do a purifying GC which moves all dynamically
- allocated objects into static space so that they stay pure. This takes
- somewhat longer than the normal GC which is otherwise done, but it's only
- done once, and subsequent GC's will be done less often and will take less
+ If true, do a purifying GC which moves all dynamically allocated
+ objects into static space so that they stay pure. This takes somewhat
+ longer than the normal GC which is otherwise done, but it's only done
+ once, and subsequent GC's will be done less often and will take less
time in the resulting core file. See PURIFY.
:ROOT-STRUCTURES
@@ -95,9 +95,9 @@
(dolist (f *after-save-initializations*)
(funcall f))
(funcall toplevel))))
- ;; FIXME: Perhaps WITHOUT-GCING should be wrapped around the
- ;; LET as well, to avoid the off chance of an interrupt triggering
- ;; GC and making our saved RESTART-LISP address invalid?
+ ;; FIXME: Perhaps WITHOUT-GCING should be wrapped around the LET
+ ;; as well, to avoid the off chance of an interrupt triggering GC
+ ;; and making our saved RESTART-LISP address invalid?
(without-gcing
(save (unix-namestring core-file-name nil)
(get-lisp-obj-address #'restart-lisp)))))
@@ -117,8 +117,8 @@
(load-native
(load name)))))
-;;; Replace a cold-loaded native object file with a byte-compiled one, if it
-;;; exists.
+;;; Replace a cold-loaded native object file with a byte-compiled one,
+;;; if it exists.
#+nil ; no longer needed in SBCL.. I think.. -- WHN 19990814
(defun byte-load-over (name)
(load (make-pathname
View
2 src/code/toplevel.lisp
@@ -290,6 +290,8 @@
(defun toplevel-init ()
(/show0 "entering TOPLEVEL-INIT")
+ (%primitive print "//entering TOPLEVEL-INIT") ; REMOVEME
+
(let ((sysinit nil) ; value of --sysinit option
(userinit nil) ; value of --userinit option
View
160 src/code/unix.lisp
@@ -194,35 +194,6 @@
(ru-nvcsw long) ; voluntary context switches
(ru-nivcsw long))) ; involuntary context switches
-
-;;;; runtime/stat-wrapper.h
-
-;;; this looks like "struct stat" according to stat(2). It may not
-;;; correspond to the real in-memory stat structure that the syscall
-;;; uses, and if it doesn't, shouldn't. Linux in particular is packed
-;;; full of stat macros, so we do this stuff in runtime/stat-wrapper.c
-
-;;; Note that st-dev is a long, not a dev-t. This is because dev-t on
-;;; linux 32 bit archs is a 64 bit quantity, but alien doesn's support
-;;; those. We don't actually access that field anywhere, though, so until
-;;; we can get 64 bit alien support it'll do
-
-(def-alien-type nil
- (struct stat
- (st-dev unsigned-long) ;would be dev-t in a real stat
- (st-ino ino-t)
- (st-mode mode-t)
- (st-nlink nlink-t)
- (st-uid uid-t)
- (st-gid gid-t)
- (st-rdev unsigned-long) ;ditto
- (st-size off-t)
- (st-blksize unsigned-long)
- (st-blocks unsigned-long)
- (st-atime time-t)
- (st-mtime time-t)
- (st-ctime time-t)))
-
;;;; unistd.h
;;; Given a file path (a string) and one of four constant modes,
@@ -306,6 +277,11 @@
(declare (type unix-pathname path))
(void-syscall ("chdir" c-string) path))
+(defun unix-mkdir (name mode)
+ (declare (type unix-pathname name)
+ (type unix-file-mode mode))
+ (void-syscall ("mkdir" c-string int) name mode))
+
;;; Return the current directory as a SIMPLE-STRING.
(defun unix-current-directory ()
;; FIXME: Gcc justifiably complains that getwd is dangerous and should
@@ -532,74 +508,98 @@
;;;; sys/stat.h
-;;; FIXME: This is only used in this file, and needn't be in target Lisp
-;;; runtime. It's also unclear why it needs to be a macro instead of a
-;;; function. Perhaps it should become a FLET.
-(defmacro extract-stat-results (buf)
- `(values T ; result
- (slot ,buf 'st-dev)
- (slot ,buf 'st-ino)
- (slot ,buf 'st-mode)
- (slot ,buf 'st-nlink)
- (slot ,buf 'st-uid)
- (slot ,buf 'st-gid)
- (slot ,buf 'st-rdev)
- (slot ,buf 'st-size)
- (slot ,buf 'st-atime)
- (slot ,buf 'st-mtime)
- (slot ,buf 'st-ctime)
- (slot ,buf 'st-blksize)
- (slot ,buf 'st-blocks)))
-
-;;; Retrieve information about the specified file returning them in
-;;; the form of multiple values. See the UNIX Programmer's Manual for
-;;; a description of the values returned. If the call fails, then NIL
-;;; and an error number is returned instead.
+;;; This is a structure defined in src/runtime/wrap.c, to look
+;;; basically like "struct stat" according to stat(2). It may not
+;;; actually correspond to the real in-memory stat structure that the
+;;; syscall uses, and that's OK. Linux in particular is packed full of
+;;; stat macros, and trying to keep Lisp code in correspondence with
+;;; it is more pain than it's worth, so we just let our C runtime
+;;; synthesize a nice consistent structure for us.
+;;;
+;;; Note that st-dev is a long, not a dev-t. This is because dev-t on
+;;; linux 32 bit archs is a 64 bit quantity, but alien doesn's support
+;;; those. We don't actually access that field anywhere, though, so
+;;; until we can get 64 bit alien support it'll do.
+(def-alien-type nil
+ (struct wrapped_stat
+ (st-dev unsigned-long) ;would be dev-t in a real stat
+ (st-ino ino-t)
+ (st-mode mode-t)
+ (st-nlink nlink-t)
+ (st-uid uid-t)
+ (st-gid gid-t)
+ (st-rdev unsigned-long) ;ditto
+ (st-size off-t)
+ (st-blksize unsigned-long)
+ (st-blocks unsigned-long)
+ (st-atime time-t)
+ (st-mtime time-t)
+ (st-ctime time-t)))
+;;; shared C-struct-to-multiple-VALUES conversion for the stat(2)
+;;; family of Unix system calls
+(defun %extract-stat-results (wrapped-stat)
+ (declare (type (alien (* (struct wrapped_stat)))))
+ (values t
+ (slot wrapped-stat 'st-dev)
+ (slot wrapped-stat 'st-ino)
+ (slot wrapped-stat 'st-mode)
+ (slot wrapped-stat 'st-nlink)
+ (slot wrapped-stat 'st-uid)
+ (slot wrapped-stat 'st-gid)
+ (slot wrapped-stat 'st-rdev)
+ ;; FIXME: OpenBSD has a 64-bit st_size slot, which is
+ ;; basically a good thing, except that it is too
+ ;; 21st-century for sbcl-0.6.12.8's FFI to handle. As a
+ ;; quick kludgy workaround, we return a 0 placeholder from
+ ;; this function, and downstream we stub out the FILE-LENGTH
+ ;; operation (which is the only place that SBCL actually
+ ;; uses the SIZE value returned from any UNIX-STAT-ish call).
+ #!+openbsd 0
+ #!-openbsd (slot wrapped-stat 'st-size)
+ (slot wrapped-stat 'st-atime)
+ (slot wrapped-stat 'st-mtime)
+ (slot wrapped-stat 'st-ctime)
+ (slot wrapped-stat 'st-blksize)
+ (slot wrapped-stat 'st-blocks)))
+
+;;; The stat(2) family of Unix system calls are implemented as calls
+;;; to C-level wrapper functions which copies all the raw "struct
+;;; stat" slots into a system-independent format, so that we don't
+;;; need to mess around with tweaking the Lisp code to correspond to
+;;; different OS/CPU combinations.
+;;; stat(2) <-> stat_wrapper()
+;;; fstat(2) <-> fstat_wrapper()
+;;; lstat(2) <-> lstat_wrapper()
+;;; Then this function is used to convert all the stat slots into
+;;; multiple return values.
(defun unix-stat (name)
(declare (type unix-pathname name))
- (when (string= name "")
- (setf name "."))
- (with-alien ((buf (struct stat)))
- (syscall ("stat_wrapper" c-string (* (struct stat)))
- (extract-stat-results buf)
+ (with-alien ((buf (struct wrapped_stat)))
+ (syscall ("stat_wrapper" c-string (* (struct wrapped_stat)))
+ (%extract-stat-results buf)
name (addr buf))))
-
(defun unix-lstat (name)
- #!+sb-doc
- "Unix-lstat is identical to unix-stat, except if NAME is
- a symlink, in which case it returns information about the
- link itself rather than dereferencing it."
(declare (type unix-pathname name))
- (with-alien ((buf (struct stat)))
- (syscall ("lstat_wrapper" c-string (* (struct stat)))
- (extract-stat-results buf)
+ (with-alien ((buf (struct wrapped_stat)))
+ (syscall ("lstat_wrapper" c-string (* (struct wrapped_stat)))
+ (%extract-stat-results buf)
name (addr buf))))
-
-;;; like UNIX-STAT except the file is specified by the file descriptor FD
(defun unix-fstat (fd)
(declare (type unix-fd fd))
- (with-alien ((buf (struct stat)))
- (syscall ("fstat_wrapper" int (* (struct stat)))
- (extract-stat-results buf)
+ (with-alien ((buf (struct wrapped_stat)))
+ (syscall ("fstat_wrapper" int (* (struct wrapped_stat)))
+ (%extract-stat-results buf)
fd (addr buf))))
-
-
-;;; UNIX-MKDIR accepts a name and a mode and attempts to create the
-;;; corresponding directory with mode mode.
-(defun unix-mkdir (name mode)
- (declare (type unix-pathname name)
- (type unix-file-mode mode))
- (void-syscall ("mkdir" c-string int) name mode))
;;;; time.h
;; the POSIX.4 structure for a time value. This is like a `struct
;; timeval' but has nanoseconds instead of microseconds.
(def-alien-type nil
(struct timespec
- (tv-sec long) ;Seconds
- (tv-nsec long))) ;Nanoseconds
+ (tv-sec long) ; seconds
+ (tv-nsec long))) ; nanoseconds
;; used by other time functions
(def-alien-type nil
View
13 src/cold/shared.lisp
@@ -21,11 +21,18 @@
;;; needing collection and copying; when the application involved is
;;; the SBCL compiler, it doesn't take any longer to collect 20Mb than
;;; 2 -dan, 20000819
-
-#+sbcl
+;;;
+;;; Actually, tweaking *BYTES-CONSED-BETWEEN-GCS* to 20Mb instead of
+;;; the default 2 seemed to make SBCL rebuild O(25%) faster on my 256
+;;; Mb K6/3, so I think it does have some effect on X86/GENCGC. I
+;;; haven't looked into why this would be, though. Also, I'm afraid
+;;; that using 20Mb here might be unfriendly to people using more-reasonable
+;;; machines (like old laptops with 48Mb of memory..) so I've
+;;; suppressed this tweak except for Alpha. -- WHN 2001-05-11
+#+(and sbcl alpha) ; SBCL/Alpha uses stop-and-copy, and Alphas have lotso RAM.
(progn
(sb-ext:gc-off)
- (setf sb-KERNEL::*bytes-consed-between-gcs* (* 20 (expt 10 6)))
+ (setf sb-kernel::*bytes-consed-between-gcs* (* 20 (expt 10 6)))
(sb-ext:gc-on)
(sb-ext:gc))
View
6 src/runtime/Config.x86-bsd
@@ -9,9 +9,11 @@
# provided with absolutely no warranty. See the COPYING and CREDITS
# files for more information.
-CFLAGS += -DGENCGC
ASSEM_SRC = x86-assem.S
ARCH_SRC = x86-arch.c
OS_SRC = bsd-os.c os-common.c undefineds.c
-OS_LIBS=-lm # -ldl
+OS_LIBS = -lm # -ldl
+
+GC_SRC = gencgc.c
+CFLAGS += -DGENCGC
View
4 src/runtime/Config.x86-linux
@@ -14,5 +14,5 @@ OS_SRC = linux-os.c x86-linux-os.c os-common.c
OS_LINK_FLAGS =
OS_LIBS = -ldl
-GC_SRC= gencgc.c
-CFLAGS += -DGENCGC
+GC_SRC = gencgc.c
+CFLAGS += -DGENCGC
View
29 src/runtime/alloc.c
@@ -41,7 +41,8 @@
#if defined(WANT_CGC) || defined(GENCGC)
extern lispobj *alloc(int bytes);
#else
-static lispobj *alloc(int bytes)
+static lispobj *
+alloc(int bytes)
{
lispobj *result;
@@ -60,7 +61,8 @@ static lispobj *alloc(int bytes)
}
#endif
-static lispobj *alloc_unboxed(int type, int words)
+static lispobj *
+alloc_unboxed(int type, int words)
{
lispobj *result;
@@ -69,7 +71,8 @@ static lispobj *alloc_unboxed(int type, int words)
return result;
}
-static lispobj alloc_vector(int type, int length, int size)
+static lispobj
+alloc_vector(int type, int length, int size)
{
struct vector *result;
@@ -82,7 +85,8 @@ static lispobj alloc_vector(int type, int length, int size)
return ((lispobj)result)|type_OtherPointer;
}
-lispobj alloc_cons(lispobj car, lispobj cdr)
+lispobj
+alloc_cons(lispobj car, lispobj cdr)
{
struct cons *ptr = (struct cons *)alloc(ALIGNED_SIZE(sizeof(struct cons)));
@@ -92,7 +96,8 @@ lispobj alloc_cons(lispobj car, lispobj cdr)
return (lispobj)ptr | type_ListPointer;
}
-lispobj alloc_number(long n)
+lispobj
+alloc_number(long n)
{
struct bignum *ptr;
@@ -107,7 +112,8 @@ lispobj alloc_number(long n)
}
}
-lispobj alloc_string(char *str)
+lispobj
+alloc_string(char *str)
{
int len = strlen(str);
lispobj result = alloc_vector(type_SimpleString, len+1, 8);
@@ -119,12 +125,13 @@ lispobj alloc_string(char *str)
return result;
}
-lispobj alloc_sap(void *ptr)
+lispobj
+alloc_sap(void *ptr)
{
- struct sap *sap = (struct sap *)alloc_unboxed
- ((int)type_Sap,
- ((sizeof (struct sap)) - (sizeof (lispobj))) / (sizeof (u32)));
-
+ int n_words_to_alloc =
+ (sizeof(struct sap) - sizeof(lispobj)) / sizeof(u32);
+ struct sap *sap =
+ (struct sap *)alloc_unboxed ((int)type_Sap, n_words_to_alloc);
sap->pointer = ptr;
return (lispobj) sap | type_OtherPointer;
}
View
12 src/runtime/bsd-os.c
@@ -204,7 +204,9 @@ is_valid_lisp_addr(os_vm_address_t addr)
void
os_install_interrupt_handlers(void)
-{}
+{
+ SHOW("os_install_interrupt_handlers()/bsd-os/!defined(GENCGC)");
+}
#else
@@ -231,13 +233,21 @@ memory_fault_handler(int signal, siginfo_t *siginfo, void *void_context)
void
os_install_interrupt_handlers(void)
{
+ SHOW("os_install_interrupt_handlers()/bsd-os/defined(GENCGC)");
+ SHOW("**1"); /* REMOVEME */
#if defined __FreeBSD__
+ SHOW("**2"); /* REMOVEME */
+ SHOW("__FreeBSD__ case");
interrupt_install_low_level_handler(SIGBUS, memory_fault_handler);
#elif defined __OpenBSD__
+ SHOW("**3"); /* REMOVEME */
+ FSHOW((stderr, "/__OpenBSD__ case, SIGSEGV=%d\n", SIGSEGV));
interrupt_install_low_level_handler(SIGSEGV, memory_fault_handler);
#else
#error unsupported BSD variant
#endif
+ SHOW("**4"); /* REMOVEME */
+ SHOW("leaving os_install_interrupt_handlers()");
}
#endif /* !defined GENCGC */
View
1 src/runtime/core.h
@@ -14,7 +14,6 @@
#include "runtime.h"
-#define CORE_PAGESIZE OS_VM_DEFAULT_PAGESIZE
#define CORE_END 3840
#define CORE_NDIRECTORY 3861
#define CORE_VALIDATE 3845
View
37 src/runtime/coreparse.c
@@ -31,11 +31,12 @@
#include "interr.h"
#include "sbcl.h"
-static void process_directory(int fd, long *ptr, int count)
+static void
+process_directory(int fd, long *ptr, int count)
{
struct ndir_entry *entry;
- FSHOW((stderr, "process_directory(..), count=%d\n", count));
+ FSHOW((stderr, "/process_directory(..), count=%d\n", count));
for (entry = (struct ndir_entry *) ptr; --count>= 0; ++entry) {
@@ -48,7 +49,8 @@ static void process_directory(int fd, long *ptr, int count)
if (len != 0) {
os_vm_address_t real_addr;
- FSHOW((stderr, "mapping %ld bytes at 0x%lx\n", len, addr));
+ FSHOW((stderr, "/mapping %ld(0x%lx) bytes at 0x%lx\n",
+ (long)len, (long)len, addr));
real_addr = os_map(fd, offset, addr, len);
if (real_addr != addr) {
lose("file mapped in wrong place! "
@@ -58,8 +60,8 @@ static void process_directory(int fd, long *ptr, int count)
}
}
- FSHOW((stderr, "space id = %d, free pointer = 0x%08x\n",
- id, free_pointer));
+ FSHOW((stderr, "/space id = %d, free pointer = 0x%08x\n",
+ id, (long)free_pointer));
switch (id) {
case DYNAMIC_SPACE_ID:
@@ -78,12 +80,16 @@ static void process_directory(int fd, long *ptr, int count)
fprintf(stderr,"warning: core/runtime address mismatch: DYNAMIC_SPACE_START");
}
#endif
+/* FIXME: Should the conditional here be reg_ALLOC instead of
+ * defined(ibmrt) || defined(__i386__)
+ * ? */
#if defined(ibmrt) || defined(__i386__)
SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer);
#else
dynamic_space_free_pointer = free_pointer;
#endif
- /* on the x86, this will always be space 0 */
+ /* With GENCGC, this will always be space 0. (We checked
+ * above that addr==DYNAMIC_SPACE_START.) */
current_dynamic_space = (lispobj *)addr;
break;
case STATIC_SPACE_ID:
@@ -106,7 +112,8 @@ static void process_directory(int fd, long *ptr, int count)
}
}
-lispobj load_core_file(char *file)
+lispobj
+load_core_file(char *file)
{
int fd = open(file, O_RDONLY), count;
@@ -123,18 +130,20 @@ lispobj load_core_file(char *file)
#endif
lispobj initial_function = NIL;
+ FSHOW((stderr, "/entering load_core_file(%s)\n", file));
if (fd < 0) {
fprintf(stderr, "could not open file \"%s\"\n", file);
perror("open");
exit(1);
}
- header=calloc(os_vm_page_size / sizeof(u32),sizeof(u32));
+ header = calloc(os_vm_page_size / sizeof(u32),sizeof(u32));
count = read(fd, header, os_vm_page_size);
if (count < os_vm_page_size) {
lose("premature end of core file");
}
+ SHOW("successfully read first page of core");
ptr = header;
val = *ptr++;
@@ -144,18 +153,23 @@ lispobj load_core_file(char *file)
val,
CORE_MAGIC);
}
+ SHOW("found CORE_MAGIC");
while (val != CORE_END) {
val = *ptr++;
len = *ptr++;
remaining_len = len - 2; /* (-2 to cancel the two ++ operations) */
+ FSHOW((stderr, "/val=0x%ld, remaining_len=0x%ld\n",
+ (long)val, (long)remaining_len));
switch (val) {
case CORE_END:
+ SHOW("CORE_END case");
break;
case CORE_VERSION:
+ SHOW("CORE_VERSION case");
if (*ptr != SBCL_CORE_VERSION_INTEGER) {
lose("core file version (%d) != runtime library version (%d)",
*ptr,
@@ -164,6 +178,7 @@ lispobj load_core_file(char *file)
break;
case CORE_NDIRECTORY:
+ SHOW("CORE_NDIRECTORY case");
process_directory(fd,
ptr,
#ifndef alpha
@@ -177,15 +192,19 @@ lispobj load_core_file(char *file)
break;
case CORE_INITIAL_FUNCTION:
+ SHOW("CORE_INITIAL_FUNCTION case");
initial_function = (lispobj)*ptr;
break;
default:
- lose("unknown core file entry: %ld", val);
+ lose("unknown core file entry: %ld", (long)val);
}
ptr += remaining_len;
+ FSHOW((stderr, "/new ptr=%x\n", ptr));
}
+ SHOW("about to free(header)");
free(header);
+ SHOW("returning from load_core_file(..)");
return initial_function;
}
View
6 src/runtime/dynbind.c
@@ -40,7 +40,8 @@ void bind_variable(lispobj symbol, lispobj value)
SetSymbolValue(symbol, value);
}
-void unbind(void)
+void
+unbind(void)
{
struct binding *binding;
lispobj symbol;
@@ -56,7 +57,8 @@ void unbind(void)
SetBSP(binding);
}
-void unbind_to_here(lispobj *bsp)
+void
+unbind_to_here(lispobj *bsp)
{
struct binding *target = (struct binding *)bsp;
struct binding *binding = GetBSP();
View
375 src/runtime/gencgc.c
@@ -128,14 +128,14 @@ boolean verify_dynamic_code_check = 0;
boolean check_code_fixups = 0;
/* Should we check that newly allocated regions are zero filled? */
-boolean gencgc_zero_check = 0;
+boolean gencgc_zero_check = 1;
/* Should we check that the free space is zero filled? */
-boolean gencgc_enable_verify_zero_fill = 0;
+boolean gencgc_enable_verify_zero_fill = 1;
/* Should we check that free pages are zero filled during gc_free_heap
* called after Lisp PURIFY? */
-boolean gencgc_zero_check_during_free_heap = 0;
+boolean gencgc_zero_check_during_free_heap = 1;
/*
* GC structures and variables
@@ -165,8 +165,8 @@ struct page page_table[NUM_PAGES];
static void *heap_base = NULL;
/* Calculate the start address for the given page number. */
-inline void
-*page_address(int page_num)
+inline void *
+page_address(int page_num)
{
return (heap_base + (page_num * 4096));
}
@@ -196,13 +196,12 @@ struct generation {
/* the first page that gc_alloc_unboxed checks on its next call */
int alloc_unboxed_start_page;
- /* the first page that gc_alloc_large (boxed) considers on its next
- * call. (Although it always allocates after the boxed_region.) */
+ /* the first page that we look at for boxed large allocations
+ (Although we always allocate after the boxed_region.) */
int alloc_large_start_page;
- /* the first page that gc_alloc_large (unboxed) considers on its
- * next call. (Although it always allocates after the
- * current_unboxed_region.) */
+ /* the first page that we look at for unboxed large allocations
+ * (Although we always allocate after the current_unboxed_region.) */
int alloc_large_unboxed_start_page;
/* the bytes allocated to this generation */
@@ -460,22 +459,94 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */
struct alloc_region boxed_region;
struct alloc_region unboxed_region;
+/* Reset the alloc_region. This indicates that it's safe to call
+ * gc_alloc_new_region() on it, and impossible to allocate space from
+ * until gc_alloc_new_region() is called on it. (The reset values are
+ * chosen so that attempts to allocate space from it will fail
+ * (because free_pointer == end_addr) and cause gc_alloc_new_region()
+ * to be called before retrying.) */
+void
+reset_alloc_region(struct alloc_region *alloc_region)
+{
+ alloc_region->first_page = 0;
+ alloc_region->last_page = -1;
+ alloc_region->start_addr =
+ alloc_region->free_pointer =
+ alloc_region->end_addr =
+ page_address(0);
+ /* REMOVEME: last-ditch sanity check for postcondition */
+ gc_assert(alloc_region_is_completely_reset(alloc_region));
+}
+
+/* Does *alloc_region look exactly like it does after
+ * reset_alloc_region() has munged it? */
+int
+alloc_region_is_completely_reset(struct alloc_region *alloc_region)
+{
+ return
+ alloc_region->first_page == 0
+ && alloc_region->last_page == -1
+ && alloc_region->start_addr == alloc_region->free_pointer
+ && alloc_region->free_pointer == alloc_region->end_addr;
+}
+
+/* Is *alloc_region in a state which it could only have gotten into by
+ * having reset_alloc_region() munge it, as it does in preparation for
+ * having gc_alloc_new_region() operate on it? I.e. are at least some
+ * key fields distinctively munged, even if some others aren't?
+ *
+ * This test is different from alloc_region_is_completely_reset(). In
+ * particular, if you reset the region, and then accidentally scribble
+ * on some of its fields, this test will be true while the other test
+ * is false. Around sbcl-0.6.12.8, merging the Alpha patches, this
+ * difference became important because of some problems with the
+ * global current_region_free_pointer being used to scribble on
+ * alloc_region.free_pointer after the alloc_region had been reset and
+ * before gc_alloc_new_region() was called. */
+int
+alloc_region_looks_reset(struct alloc_region *alloc_region)
+{
+ return
+ alloc_region->first_page == 0
+ && alloc_region->last_page == -1;
+}
+
+/* (should only be needed for debugging or assertion failure reporting) */
+void
+fprint_alloc_region(FILE *file, struct alloc_region *alloc_region)
+{
+ fprintf(file,
+ "alloc_region *0x%0lx:
+ first_page=0x%08lx, last_page=0x%08lx,
+ start_addr=0x%08lx, free_pointer=0x%08lx, end_addr=0x%08lx\n",
+ (unsigned long)alloc_region,
+ (unsigned long)alloc_region->first_page,
+ (unsigned long)alloc_region->last_page,
+ (unsigned long)alloc_region->start_addr,
+ (unsigned long)alloc_region->free_pointer,
+ (unsigned long)alloc_region->end_addr);
+}
+
+
/* XX hack. Current Lisp code uses the following. Need copying in/out. */
void *current_region_free_pointer;
void *current_region_end_addr;
-/* The generation currently being allocated to. */
+/* the generation currently being allocated to */
static int gc_alloc_generation;
-/* Find a new region with room for at least the given number of bytes.
+/* Set *alloc_region to refer to a new region with room for at least
+ * the given number of bytes.
+ *
+ * Before the call to this function, *alloc_region should have been
+ * closed by a call to gc_alloc_update_page_tables(), and will thus be
+ * in an empty "reset" state. Upon return from this function, it should
+ * no longer be in a reset state.
*
- * It starts looking at the current generation's alloc_start_page. So
+ * We start by looking at the current generation's alloc_start_page. So
* may pick up from the previous region if there is enough space. This
* keeps the allocation contiguous when scavenging the newspace.
*
- * The alloc_region should have been closed by a call to
- * gc_alloc_update_page_tables, and will thus be in an empty state.
- *
* To assist the scavenging functions write-protected pages are not
* used. Free pages should not be write-protected.
*
@@ -488,8 +559,7 @@ static int gc_alloc_generation;
* from space can be recognized. Therefore the generation of pages in
* the region are set to gc_alloc_generation. To prevent another
* allocation call using the same pages, all the pages in the region
- * are allocated, although they will initially be empty.
- */
+ * are allocated, although they will initially be empty. */
static void
gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region)
{
@@ -501,16 +571,13 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region)
int num_pages;
int i;
- /*
- FSHOW((stderr,
- "/alloc_new_region for %d bytes from gen %d\n",
- nbytes, gc_alloc_generation));
- */
-
- /* Check that the region is in a reset state. */
- gc_assert((alloc_region->first_page == 0)
- && (alloc_region->last_page == -1)
- && (alloc_region->free_pointer == alloc_region->end_addr));
+ /* Check invariant as per the interface definition comment above. */
+ if (!alloc_region_is_completely_reset(alloc_region)) {
+ fprintf(stderr,
+ "Argh! alloc_region not reset in gc_alloc_new_region()\n");
+ fprint_alloc_region(stderr, alloc_region);
+ lose(0);
+ }
if (unboxed) {
restart_page =
@@ -542,7 +609,8 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region)
/* Check for a failure. */
if (first_page >= NUM_PAGES) {
fprintf(stderr,
- "Argh! gc_alloc_new_region failed on first_page, nbytes=%d.\n",
+ "Argh! gc_alloc_new_region() failed on first_page, "
+ "nbytes=%d.\n",
nbytes);
print_generation_stats(1);
lose(NULL);
@@ -640,10 +708,11 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region)
page_table[first_page].first_object_offset = 0;
}
- if (unboxed)
+ if (unboxed) {
gc_assert(page_table[first_page].allocated == UNBOXED_PAGE);
- else
+ } else {
gc_assert(page_table[first_page].allocated == BOXED_PAGE);
+ }
gc_assert(page_table[first_page].gen == gc_alloc_generation);
gc_assert(page_table[first_page].large_object == 0);
@@ -668,6 +737,9 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region)
if (last_page+1 > last_used_page)
last_used_page = last_page+1;
}
+
+ /* postcondition sanity check*/
+ gc_assert(!alloc_region_is_completely_reset(alloc_region));
}
/* If the record_new_objects flag is 2 then all new regions created
@@ -762,13 +834,13 @@ add_new_area(int first_page, int offset, int size)
max_new_areas = new_areas_index;
}
-/* Update the tables for the alloc_region. The region maybe added to
+/* Update the tables for the alloc_region. The region may be added to
* the new_areas.
*
- * When done the alloc_region is set up so that the next quick alloc
- * will fail safely and thus a new region will be allocated. Further
- * it is safe to try to re-update the page table of this reset
- * alloc_region. */
+ * When done the alloc_region is "reset", i.e. set up so that the next
+ * quick alloc will fail safely and thus a new region will be
+ * allocated. Further it is safe to try to re-update the page table of
+ * this reset alloc_region. */
void
gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
{
@@ -792,15 +864,25 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
if ((first_page == 0) && (alloc_region->last_page == -1))
return;
- next_page = first_page+1;
+ next_page = first_page + 1;
- /* Skip if no bytes were allocated */
+ /* Skip if no bytes were allocated. */
if (alloc_region->free_pointer != alloc_region->start_addr) {
+
+ /* hunting for invariant violations from the Alpha patches ca.
+ * sbcl-0.6.12.8: It's OK -- I think -- for
+ * gc_alloc_update_page_tables() to be called on a reset
+ * alloc_region, but it's not OK in that case for the
+ * alloc_region.free_pointer to have been modified since the
+ * reset, i.e. the inequality tested just above.
+ * -- WHN 2001-05-14 */
+ gc_assert(!alloc_region_looks_reset(alloc_region));
+
orig_first_page_bytes_used = page_table[first_page].bytes_used;
gc_assert(alloc_region->start_addr == (page_address(first_page) + page_table[first_page].bytes_used));
- /* All the pages used need to be updated */
+ /* All the pages used need to be updated. */
/* Update the first page. */
@@ -809,27 +891,30 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
if (page_table[first_page].bytes_used == 0)
gc_assert(page_table[first_page].first_object_offset == 0);
- if (unboxed)
+ if (unboxed) {
gc_assert(page_table[first_page].allocated == UNBOXED_PAGE);
- else
+ } else {
gc_assert(page_table[first_page].allocated == BOXED_PAGE);
+ }
gc_assert(page_table[first_page].gen == gc_alloc_generation);
gc_assert(page_table[first_page].large_object == 0);
byte_cnt = 0;
- /* Calc. the number of bytes used in this page. This is not always
- the number of new bytes, unless it was free. */
+ /* Calculate the number of bytes used in this page. This is
+ not always the number of new bytes, unless it was free. */
more = 0;
- if ((bytes_used = (alloc_region->free_pointer - page_address(first_page)))>4096) {
+ bytes_used =
+ alloc_region->free_pointer - page_address(first_page);
+ if (bytes_used > 4096) {
bytes_used = 4096;
more = 1;
}
page_table[first_page].bytes_used = bytes_used;
byte_cnt += bytes_used;
- /* All the rest of the pages should be free. Need to set their
+ /* All the rest of the pages should be free. We need to set their
first_object_offset pointer to the start of the region, and set
the bytes_used. */
while (more) {
@@ -845,9 +930,14 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
alloc_region->start_addr - page_address(next_page));
/* Calculate the number of bytes used in this page. */
+ /* FIXME: This code is duplicated about 20 lines above, in
+ * order to be executed on the first pass. Isn't
+ * there some way to move that duplicated block into the
+ * while() loop, converting it into repeat..until? */
more = 0;
- if ((bytes_used = (alloc_region->free_pointer
- - page_address(next_page)))>4096) {
+ bytes_used =
+ alloc_region->free_pointer - page_address(next_page);
+ if (bytes_used > 4096) {
bytes_used = 4096;
more = 1;
}
@@ -857,36 +947,39 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
next_page++;
}
- region_size = alloc_region->free_pointer - alloc_region->start_addr;
+ region_size =
+ alloc_region->free_pointer - alloc_region->start_addr;
bytes_allocated += region_size;
generations[gc_alloc_generation].bytes_allocated += region_size;
gc_assert((byte_cnt- orig_first_page_bytes_used) == region_size);
/* Set the generations alloc restart page to the last page of
- the region. */
- if (unboxed)
+ * the region. */
+ if (unboxed) {
generations[gc_alloc_generation].alloc_unboxed_start_page =
next_page-1;
- else
+ } else {
generations[gc_alloc_generation].alloc_start_page = next_page-1;
+ }
/* Add the region to the new_areas if requested. */
- if (!unboxed)
+ if (!unboxed) {
add_new_area(first_page,orig_first_page_bytes_used, region_size);
+ }
/*
FSHOW((stderr,
"/gc_alloc_update_page_tables update %d bytes to gen %d\n",
region_size,
gc_alloc_generation));
*/
- }
- else
- /* No bytes allocated. Unallocate the first_page if there are 0
- bytes_used. */
+ } else {
+ /* No bytes were allocated. Unallocate the first_page if there
+ * are 0 bytes_used. */
if (page_table[first_page].bytes_used == 0)
page_table[first_page].allocated = FREE_PAGE;
+ }
/* Unallocate any unused pages. */
while (next_page <= alloc_region->last_page) {
@@ -895,19 +988,16 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
next_page++;
}
- /* Reset the alloc_region. */
- alloc_region->first_page = 0;
- alloc_region->last_page = -1;
- alloc_region->start_addr = page_address(0);
- alloc_region->free_pointer = page_address(0);
- alloc_region->end_addr = page_address(0);
+ reset_alloc_region(alloc_region);
}
static inline void *gc_quick_alloc(int nbytes);
/* Allocate a possibly large object. */
-static void
-*gc_alloc_large(int nbytes, int unboxed, struct alloc_region *alloc_region)
+static void *
+gc_alloc_possibly_large(int nbytes,
+ int unboxed,
+ struct alloc_region *alloc_region)
{
int first_page;
int last_page;
@@ -929,14 +1019,14 @@ static void
/*
FSHOW((stderr,
- "/gc_alloc_large for %d bytes from gen %d\n",
- nbytes, gc_alloc_generation));
+ "/gc_alloc_possibly_large for %d bytes (large=%d) from gen %d\n",
+ nbytes, large, gc_alloc_generation));
*/
/* If the object is small, and there is room in the current region
then allocation it in the current region. */
if (!large
- && ((alloc_region->end_addr-alloc_region->free_pointer) >= nbytes))
+ && ((alloc_region->end_addr - alloc_region->free_pointer) >= nbytes))
return gc_quick_alloc(nbytes);
/* Search for a contiguous free region of at least nbytes. If it's a
@@ -949,7 +1039,8 @@ static void
index ahead of the current region and bumped up here to save a
lot of re-scanning. */
if (unboxed)
- restart_page = generations[gc_alloc_generation].alloc_large_unboxed_start_page;
+ restart_page =
+ generations[gc_alloc_generation].alloc_large_unboxed_start_page;
else
restart_page = generations[gc_alloc_generation].alloc_large_start_page;
if (restart_page <= alloc_region->last_page)
@@ -978,7 +1069,8 @@ static void
if (first_page >= NUM_PAGES) {
fprintf(stderr,
- "Argh! gc_alloc_large failed (first_page), nbytes=%d.\n",
+ "Argh! gc_alloc_possibly_large failed (first_page), "
+ "nbytes=%d.\n",
nbytes);
print_generation_stats(1);
lose(NULL);
@@ -1021,7 +1113,8 @@ static void
/* Check for a failure */
if ((restart_page >= NUM_PAGES) && (bytes_found < nbytes)) {
fprintf(stderr,
- "Argh! gc_alloc_large failed (restart_page), nbytes=%d.\n",
+ "Argh! gc_alloc_possibly_large failed (restart_page), "
+ "nbytes=%d.\n",
nbytes);
print_generation_stats(1);
lose(NULL);
@@ -1030,7 +1123,7 @@ static void
/*
if (large)
FSHOW((stderr,
- "/gc_alloc_large gen %d: %d of %d bytes: from pages %d to %d: addr=%x\n",
+ "/gc_alloc_possibly_large gen %d: %d of %d bytes: from pages %d to %d: addr=%x\n",
gc_alloc_generation,
nbytes,
bytes_found,
@@ -1134,8 +1227,8 @@ static void
/* Allocate bytes from the boxed_region. It first checks if there is
* room, if not then it calls gc_alloc_new_region to find a new region
* with enough space. A pointer to the start of the region is returned. */
-static void
-*gc_alloc(int nbytes)
+static void *
+gc_alloc(int nbytes)
{
void *new_free_pointer;
@@ -1165,7 +1258,7 @@ static void
* saving, then allocate a large object. */
/* FIXME: "32" should be a named parameter. */
if ((boxed_region.end_addr-boxed_region.free_pointer) > 32)
- return gc_alloc_large(nbytes, 0, &boxed_region);
+ return gc_alloc_possibly_large(nbytes, 0, &boxed_region);
/* Else find a new region. */
@@ -1205,8 +1298,8 @@ static void
/* Allocate space from the boxed_region. If there is not enough free
* space then call gc_alloc to do the job. A pointer to the start of
* the region is returned. */
-static inline void
-*gc_quick_alloc(int nbytes)
+static inline void *
+gc_quick_alloc(int nbytes)
{
void *new_free_pointer;
@@ -1220,21 +1313,21 @@ static inline void
return((void *)new_obj);
}
- /* Else call gc_alloc */
- return (gc_alloc(nbytes));
+ /* Else call gc_alloc(). */
+ return gc_alloc(nbytes);
}
/* Allocate space for the boxed object. If it is a large object then
* do a large alloc else allocate from the current region. If there is
* not enough free space then call gc_alloc to do the job. A pointer
* to the start of the region is returned. */
-static inline void
-*gc_quick_alloc_large(int nbytes)
+static inline void *
+gc_quick_alloc_large(int nbytes)
{
void *new_free_pointer;
if (nbytes >= large_object_size)
- return gc_alloc_large(nbytes, 0, &boxed_region);
+ return gc_alloc_possibly_large(nbytes, 0, &boxed_region);
/* Check whether there is room in the current region. */
new_free_pointer = boxed_region.free_pointer + nbytes;
@@ -1250,8 +1343,8 @@ static inline void
return (gc_alloc(nbytes));
}
-static void
-*gc_alloc_unboxed(int nbytes)
+static void *
+gc_alloc_unboxed(int nbytes)
{
void *new_free_pointer;
@@ -1284,7 +1377,7 @@ static void
/* If there is a bit of room left in the current region then
allocate a large object. */
if ((unboxed_region.end_addr-unboxed_region.free_pointer) > 32)
- return gc_alloc_large(nbytes,1,&unboxed_region);
+ return gc_alloc_possibly_large(nbytes,1,&unboxed_region);
/* Else find a new region. */
@@ -1321,8 +1414,8 @@ static void
return((void *) NIL); /* dummy value: return something ... */
}
-static inline void
-*gc_quick_alloc_unboxed(int nbytes)
+static inline void *
+gc_quick_alloc_unboxed(int nbytes)
{
void *new_free_pointer;
@@ -1346,13 +1439,13 @@ static inline void
* enough free space then call gc_alloc to do the job.
*
* A pointer to the start of the region is returned. */
-static inline void
-*gc_quick_alloc_large_unboxed(int nbytes)
+static inline void *
+gc_quick_alloc_unboxed_possibly_large(int nbytes)
{
void *new_free_pointer;
if (nbytes >= large_object_size)
- return gc_alloc_large(nbytes,1,&unboxed_region);
+ return gc_alloc_possibly_large(nbytes,1,&unboxed_region);
/* Check whether there is room in the current region. */
new_free_pointer = unboxed_region.free_pointer + nbytes;
@@ -1722,7 +1815,7 @@ copy_large_unboxed_object(lispobj object, int nwords)
tag = LowtagOf(object);
/* Allocate space. */
- new = gc_quick_alloc_large_unboxed(nwords*4);
+ new = gc_quick_alloc_unboxed_possibly_large(nwords*4);
dest = new;
source = (lispobj *) PTR(object);
@@ -1762,7 +1855,7 @@ scavenge(lispobj *start, long nwords)
object = *start;
-/* FSHOW((stderr, "Scavenge: %p, %ld\n", start, nwords)); */
+/* FSHOW((stderr, "/Scavenge: %p, %ld\n", start, nwords)); */
gc_assert(object != 0x01); /* not a forwarding pointer */
@@ -1935,7 +2028,7 @@ sniff_code_object(struct code *code, unsigned displacement)
/* It's ok if it's byte compiled code. The trace table offset will
* be a fixnum if it's x86 compiled code - check. */
if (code->trace_table_offset & 0x3) {
- FSHOW((stderr, "/Sniffing byte compiled code object at %x.\n", code));
+ FSHOW((stderr, "/sniffing byte compiled code object at %x\n", code));
return;
}
@@ -3028,7 +3121,7 @@ scav_vector(lispobj *where, lispobj object)
(kv_vector[2*i] != empty_symbol))) {
/*FSHOW((stderr,
- "* EQ key %d moved from %x to %x; index %d to %d\n",
+ "/EQ key %d moved from %x to %x; index %d to %d\n",
i, old_key, new_key, old_index, new_index));*/
if (index_vector[old_index] != 0) {
@@ -3664,7 +3757,7 @@ trans_weak_pointer(lispobj object)
gc_assert(Pointerp(object));
#if defined(DEBUG_WEAK)
- FSHOW((stderr, "Transporting weak pointer from 0x%08x\n", object));
+ FSHOW((stderr, "/transporting weak pointer from 0x%08x\n", object));
#endif
/* Need to remember where all the weak pointers are that have */
@@ -4206,7 +4299,7 @@ valid_dynamic_space_pointer(lispobj *pointer)
case type_BaseChar:
if (gencgc_verbose)
FSHOW((stderr,
- "*Wo3: %x %x %x\n",
+ "/Wo3: %x %x %x\n",
pointer, start_addr, *start_addr));
return 0;
@@ -4217,14 +4310,14 @@ valid_dynamic_space_pointer(lispobj *pointer)
case type_ByteCodeClosure:
if (gencgc_verbose)
FSHOW((stderr,
- "*Wo4: %x %x %x\n",
+ "/Wo4: %x %x %x\n",
pointer, start_addr, *start_addr));
return 0;
case type_InstanceHeader:
if (gencgc_verbose)
FSHOW((stderr,
- "*Wo5: %x %x %x\n",
+ "/Wo5: %x %x %x\n",
pointer, start_addr, *start_addr));
return 0;
@@ -4304,7 +4397,7 @@ valid_dynamic_space_pointer(lispobj *pointer)
default:
if (gencgc_verbose)
FSHOW((stderr,
- "*W?: %x %x %x\n",
+ "/W?: %x %x %x\n",
pointer, start_addr, *start_addr));
return 0;
}
@@ -4528,7 +4621,7 @@ preserve_pointer(void *addr)
|| (((unsigned)addr & 0xfff)
> page_table[addr_page_index].bytes_used)) {
FSHOW((stderr,
- "weird? ignore ptr 0x%x to freed area of large object\n",
+ "/weird? ignore ptr 0x%x to freed area of large object\n",
addr));
return;
}
@@ -4625,7 +4718,7 @@ scavenge_thread_stacks(void)
}
if (gencgc_verbose > 1) {
FSHOW((stderr,
- "scavenging %d words of control stack %d of length %d words.\n",
+ "/scavenging %d words of control stack %d of length %d words.\n",
length, i, vector_length));
}
for (j = 0; j < length; j++) {
@@ -4953,7 +5046,7 @@ scavenge_newspace_generation_one_scan(int generation)
if ((all_wp != 0) && (a1 != bytes_allocated)) {
FSHOW((stderr,
- "alloc'ed over %d to %d\n",
+ "/alloc'ed over %d to %d\n",
i, last_page));
FSHOW((stderr,
"/page: bytes_used=%d first_object_offset=%d dont_move=%d wp=%d wpc=%d\n",
@@ -5020,7 +5113,7 @@ scavenge_newspace_generation(int generation)
current_new_areas_index = new_areas_index;
/*FSHOW((stderr,
- "The first scan is finished; current_new_areas_index=%d.\n",
+ "/The first scan is finished; current_new_areas_index=%d.\n",
current_new_areas_index));*/
while (current_new_areas_index > 0) {
@@ -5087,7 +5180,7 @@ scavenge_newspace_generation(int generation)
current_new_areas_index = new_areas_index;
/*FSHOW((stderr,
- "The re-scan has finished; current_new_areas_index=%d.\n",
+ "/The re-scan has finished; current_new_areas_index=%d.\n",
current_new_areas_index));*/
}
@@ -5230,6 +5323,7 @@ free_oldspace(void)
return bytes_freed;
}
+#if 0 /* not used as of sbcl-0.6.12.8 */
/* Print some information about a pointer at the given address. */
static void
print_ptr(lispobj *addr)
@@ -5257,6 +5351,7 @@ print_ptr(lispobj *addr)
*(addr+3),
*(addr+4));
}
+#endif
extern int undefined_tramp;
@@ -5546,20 +5641,6 @@ verify_zero_fill(void)
}
}
-/* External entry point for verify_zero_fill */
-void
-gencgc_verify_zero_fill(void)
-{
- /* Flush the alloc regions updating the tables. */
- boxed_region.free_pointer = current_region_free_pointer;
- gc_alloc_update_page_tables(0, &boxed_region);
- gc_alloc_update_page_tables(1, &unboxed_region);
- SHOW("verifying zero fill");
- verify_zero_fill();
- current_region_free_pointer = boxed_region.free_pointer;
- current_region_end_addr = boxed_region.end_addr;
-}
-
static void
verify_dynamic_space(void)
{
@@ -5778,8 +5859,7 @@ garbage_collect_generation(int generation, int raise)
generations[generation].alloc_large_unboxed_start_page = 0;
if (generation >= verify_gens) {
- if (gencgc_verbose)
- SHOW("verifying");
+ SHOW("verifying");
verify_gc();
verify_dynamic_space();
}
@@ -5789,10 +5869,11 @@ garbage_collect_generation(int generation, int raise)
generations[generation].bytes_allocated
+ generations[generation].bytes_consed_between_gc;
- if (raise)
+ if (raise) {
generations[generation].num_gc = 0;
- else
+ } else {
++generations[generation].num_gc;
+ }
}
/* Update last_free_page then ALLOCATION_POINTER */
@@ -5802,15 +5883,25 @@ update_x86_dynamic_space_free_pointer(void)
int last_page = -1;
int i;
+ FSHOW((stderr,
+ "/entering update_x86_dynamic_space_free_pointer(), "
+ "old value=0x%lx\n",
+ (long)SymbolValue(ALLOCATION_POINTER)));
for (i = 0; i < NUM_PAGES; i++)
if ((page_table[i].allocated != FREE_PAGE)
&& (page_table[i].bytes_used != 0))
last_page = i;
- last_free_page = last_page+1;
+ last_free_page = last_page + 1;
SetSymbolValue(ALLOCATION_POINTER,
(lispobj)(((char *)heap_base) + last_free_page*4096));
+
+ FSHOW((stderr,
+ "/leaving update_x86_dynamic_space_free_pointer(), "
+ "new value=0x%lx\n",
+ (long)SymbolValue(ALLOCATION_POINTER)));
+
return 0; /* dummy value: return something ... */
}
@@ -5830,6 +5921,11 @@ collect_garbage(unsigned last_gen)
int gen_to_wp;
int i;
+ /* We're about to modify boxed_region in a way which would mess up its
+ * nice tidy reset state if it is currently reset, so make sure it
+ * isn't currently reset: */
+ gc_assert(!alloc_region_looks_reset(&boxed_region));
+
boxed_region.free_pointer = current_region_free_pointer;
FSHOW((stderr, "/entering collect_garbage(%d)\n", last_gen));
@@ -5847,7 +5943,7 @@ collect_garbage(unsigned last_gen)
/* Verify the new objects created by Lisp code. */
if (pre_verify_gen_0) {
- SHOW((stderr, "pre-checking generation 0\n"));
+ SHOW("pre-checking generation 0\n");
verify_generation(0);
}
@@ -5868,7 +5964,7 @@ collect_garbage(unsigned last_gen)
if (gencgc_verbose > 1) {
FSHOW((stderr,
- "Starting GC of generation %d with raise=%d alloc=%d trig=%d GCs=%d\n",
+ "/starting GC of generation %d with raise=%d alloc=%d trig=%d GCs=%d\n",
gen,
raise,
generations[gen].bytes_allocated,
@@ -5889,7 +5985,7 @@ collect_garbage(unsigned last_gen)
generations[gen].cum_sum_bytes_allocated = 0;
if (gencgc_verbose > 1) {
- FSHOW((stderr, "GC of generation %d finished:\n", gen));
+ FSHOW((stderr, "/GC of generation %d finished:\n", gen));
print_generation_stats(0);
}
@@ -6016,19 +6112,10 @@ gc_free_heap(void)
if (gencgc_verbose > 1)
print_generation_stats(0);
- /* Initialize gc_alloc */
+ /* Initialize gc_alloc(). */
gc_alloc_generation = 0;
- boxed_region.first_page = 0;
- boxed_region.last_page = -1;
- boxed_region.start_addr = page_address(0);
- boxed_region.free_pointer = page_address(0);
- boxed_region.end_addr = page_address(0);
-
- unboxed_region.first_page = 0;
- unboxed_region.last_page = -1;
- unboxed_region.start_addr = page_address(0);
- unboxed_region.free_pointer = page_address(0);
- unboxed_region.end_addr = page_address(0);
+ reset_alloc_region(&boxed_region);
+ reset_alloc_region(&unboxed_region);
#if 0 /* Lisp PURIFY is currently running on the C stack so don't do this. */
zero_stack();
@@ -6042,8 +6129,7 @@ gc_free_heap(void)
if (verify_after_free_heap) {
/* Check whether purify has left any bad pointers. */
- if (gencgc_verbose)
- SHOW("checking after free_heap\n");
+ SHOW("checking after free_heap\n");
verify_gc();
}
}
@@ -6117,6 +6203,8 @@ gencgc_pickup_dynamic(void)
int addr = DYNAMIC_SPACE_START;
int alloc_ptr = SymbolValue(ALLOCATION_POINTER);
+ SHOW("entering gencgc_pickup_dynamic()");
+
/* Initialize the first region. */
do {
page_table[page].allocated = BOXED_PAGE;
@@ -6134,6 +6222,8 @@ gencgc_pickup_dynamic(void)
current_region_free_pointer = boxed_region.free_pointer;
current_region_end_addr = boxed_region.end_addr;
+
+ SHOW("returning from gencgc_pickup_dynamic()");
}
/* a counter for how deep we are in alloc(..) calls */
@@ -6353,9 +6443,12 @@ gencgc_handle_wp_violation(void* fault_addr)
{
int page_index = find_page_index(fault_addr);
+ /* (When the write barrier is working right, this message is just
+ * a distraction; but when you're trying to get the write barrier
+ * to work, or grok what it's doing, it can be very handy.) */
#if defined QSHOW_SIGNALS
- FSHOW((stderr, "heap WP violation? fault_addr=%x, page_index=%d\n",
- fault_addr, page_index));
+ FSHOW((stderr, "/heap WP violation? fault_addr=0x%0lx, page_index=%d\n",
+ (unsigned long)fault_addr, page_index));
#endif
/* Check whether the fault is within the dynamic space. */
View
12 src/runtime/gencgc.h
@@ -30,11 +30,12 @@ struct page {
* (If the page is written into, we catch the exception, make
* the page writable, and clear this flag.) */
write_protected :1,
- /* This flag is set when the above write_protected flag is
- * cleared by the sigbus handler. This is useful for
- * re-scavenging pages that are written during a GC. */
+ /* This flag is set when the above write_protected flag is
+ * cleared by the SIGBUS handler (or SIGSEGV handler, for some
+ * OSes). This is useful for * re-scavenging pages that are
+ * written during a GC. */
write_protected_cleared :1,
- /* The region the page is allocated to: 0 for a free page; 1
+ /* the region the page is allocated to: 0 for a free page; 1
* for boxed objects; 2 for unboxed objects. If the page is
* free the following slots are invalid (well the bytes_used
* must be 0). */
@@ -65,6 +66,7 @@ struct page {
int first_object_offset;
};
+/* values for the page.allocated field */
#define FREE_PAGE 0
#define BOXED_PAGE 1
#define UNBOXED_PAGE 2
@@ -81,7 +83,7 @@ struct alloc_region {
void *free_pointer;
void *end_addr; /* pointer to the byte after the last usable byte */
- /* needed when closing the region */
+ /* These are needed when closing the region. */
int first_page;
int last_page;
void *start_addr;
View
13 src/runtime/globals.c
@@ -41,10 +41,15 @@ lispobj *dynamic_space_free_pointer;
lispobj *current_auto_gc_trigger;
#endif
-/* for copying GCs, this points to the start of the dynamic sp