mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
0.6.12.7.flaky1.1:
(As per Daniel Barlow sbcl-devel 2001-05-17, the removal of the mysterious "" special case in UNIX-STAT will probably keep this version from building itself, so I didn't even try. It does, however, at least do "sh run-tests.sh" successfully.) fixed declaration in %EXTRACT-STAT-RESULTS so that the system won't have to interpret the alien reference at runtime on every call to the function I found how to fix the boot/gencgc/purify problem which was leaving initial-function unmapped -- I could copy current_region_free_pointer into boxed_region.free_pointer just before gc_alloc_update_page_pages() in save.c. However, that left me with other flaky GC problems. So I gave up my GC hacking in this version as a bad job, and copied original 0.6.12.7 GC-related files over the modified versions: gencgc.c, save.c, purify.c, gc.lisp, save.lisp made %EXTRACT-STAT-RESULTS inline to suppress an apparent memory corruption bug
This commit is contained in:
William Harold Newman
parent
d7f6139a91
commit
c8322df812
7
clean.sh
7
clean.sh
|
|
@ -26,7 +26,12 @@ rm -rf obj/* output/* doc/user-manual \
|
|||
pwd=`pwd`
|
||||
for d in tools-for-build; do
|
||||
cd $d
|
||||
make clean
|
||||
# I hope the -s option is standard. At least GNU make and BSD make
|
||||
# support it. It silences make, since otherwise the output from
|
||||
# this script is just the operations done by these make's, which
|
||||
# is misleading when this script does lotso other operations too.
|
||||
# -- WHN
|
||||
make -s clean
|
||||
cd $pwd
|
||||
done
|
||||
|
||||
|
|
|
|||
|
|
@ -111,6 +111,8 @@ $SBCL_XC_HOST <<-'EOF' || exit 1
|
|||
;;)
|
||||
EOF
|
||||
|
||||
# Run GENESIS (again) (The first time was before we ran the
|
||||
# cross-compiler.) in order to create cold-sbcl.core.
|
||||
# Run GENESIS (again) in order to create cold-sbcl.core. (The first
|
||||
# time was before we ran the cross-compiler, in order to create the
|
||||
# header file which was needed in order to run gcc on the runtime
|
||||
# code.)
|
||||
sh make-genesis-2.sh
|
||||
|
|
|
|||
|
|
@ -46,8 +46,5 @@ 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)
|
||||
;; 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)
|
||||
(sb-ext:save-lisp-and-die "output/sbcl.core" :purify t)
|
||||
EOF
|
||||
|
|
|
|||
|
|
@ -255,7 +255,7 @@
|
|||
;; could be typed directly, with no parentheses, at the debug prompt
|
||||
;; the way that e.g. F or BACKTRACE can be?)
|
||||
|
||||
(/show0 "done initializing")
|
||||
(/show0 "done initializing, setting *COLD-INIT-COMPLETE-P*")
|
||||
(setf *cold-init-complete-p* t)
|
||||
(%primitive print "//set *COLD-INIT-COMPLETE-P*") ; REMOVEME
|
||||
|
||||
|
|
|
|||
|
|
@ -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 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.)
|
||||
;;; 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.)
|
||||
(defun save-lisp-and-die (core-file-name &key
|
||||
(toplevel #'toplevel-init)
|
||||
(purify nil)
|
||||
(root-structures ())
|
||||
(environment-name "auxiliary"))
|
||||
#!+sb-doc
|
||||
"Save a CMU Common Lisp core image in the file of the specified name,
|
||||
"Saves 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 arguments are defined:
|
||||
The following &KEY args 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, 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 (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
|
||||
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
|
||||
|
|
|
|||
|
|
@ -522,13 +522,13 @@
|
|||
;;; 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-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-rdev unsigned-long) ; would be dev-t in a real stat
|
||||
(st-size off-t)
|
||||
(st-blksize unsigned-long)
|
||||
(st-blocks unsigned-long)
|
||||
|
|
@ -538,8 +538,19 @@
|
|||
|
||||
;;; shared C-struct-to-multiple-VALUES conversion for the stat(2)
|
||||
;;; family of Unix system calls
|
||||
;;;
|
||||
;;; FIXME: I think this should probably not be INLINE. However, when
|
||||
;;; this was not inline, it seemed to cause memory corruption
|
||||
;;; problems. My first guess is that it's a bug in the FFI code, where
|
||||
;;; the WITH-ALIEN expansion doesn't deal well with being wrapped
|
||||
;;; around a call to a function returning >10 values. But I didn't try
|
||||
;;; to figure it out, just inlined it as a quick fix. Perhaps someone
|
||||
;;; who's motivated to debug the FFI code can go over the DISASSEMBLE
|
||||
;;; output in the not-inlined case and see whether there's a problem,
|
||||
;;; and maybe even find a fix..
|
||||
(declaim (inline %extract-stat-results))
|
||||
(defun %extract-stat-results (wrapped-stat)
|
||||
(declare (type (alien (* (struct wrapped_stat)))))
|
||||
(declare (type (alien (* (struct wrapped_stat))) wrapped-stat))
|
||||
(values t
|
||||
(slot wrapped-stat 'st-dev)
|
||||
(slot wrapped-stat 'st-ino)
|
||||
|
|
@ -563,33 +574,29 @@
|
|||
(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.
|
||||
;;; Unix system calls in the stat(2) family are implemented as calls
|
||||
;;; to C-level wrapper functions which copy all the raw "struct
|
||||
;;; stat" slots into the system-independent wrapped_stat format.
|
||||
;;; 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))
|
||||
(with-alien ((buf (struct wrapped_stat)))
|
||||
(syscall ("stat_wrapper" c-string (* (struct wrapped_stat)))
|
||||
(%extract-stat-results buf)
|
||||
(%extract-stat-results (addr buf))
|
||||
name (addr buf))))
|
||||
(defun unix-lstat (name)
|
||||
(declare (type unix-pathname name))
|
||||
(with-alien ((buf (struct wrapped_stat)))
|
||||
(syscall ("lstat_wrapper" c-string (* (struct wrapped_stat)))
|
||||
(%extract-stat-results buf)
|
||||
(%extract-stat-results (addr buf))
|
||||
name (addr buf))))
|
||||
(defun unix-fstat (fd)
|
||||
(declare (type unix-fd fd))
|
||||
(with-alien ((buf (struct wrapped_stat)))
|
||||
(syscall ("fstat_wrapper" int (* (struct wrapped_stat)))
|
||||
(%extract-stat-results buf)
|
||||
(%extract-stat-results (addr buf))
|
||||
fd (addr buf))))
|
||||
|
||||
;;;; time.h
|
||||
|
|
|
|||
|
|
@ -122,9 +122,12 @@
|
|||
;;; on DYNAMIC-EXTENT would probably give a better payoff.)
|
||||
(defvar *maybe-use-inline-allocation* t)
|
||||
|
||||
;;; Call into C.
|
||||
;;; Emit code to allocate an object with a size in bytes given by
|
||||
;;; Size. The size may be an integer of a TN. If Inline is a VOP
|
||||
;;; node-var then it is used to make an appropriate speed vs size
|
||||
;;; decision.
|
||||
;;;
|
||||
;;; FIXME: Except when inline allocation is enabled..?
|
||||
;;; FIXME: We call into C.. except when inline allocation is enabled..?
|
||||
;;;
|
||||
;;; FIXME: Also, calls to
|
||||
;;; ALLOCATION are always wrapped with PSEUDO-ATOMIC -- why? Is it to
|
||||
|
|
@ -138,11 +141,6 @@
|
|||
;;; formalized, in documentation and in macro definition,
|
||||
;;; with the macro becoming e.g. PSEUDO-ATOMIC-ALLOCATION.
|
||||
(defun allocation (alloc-tn size &optional inline)
|
||||
#!+sb-doc
|
||||
"Emit code to allocate an object with a size in bytes given by Size.
|
||||
The size may be an integer of a TN.
|
||||
If Inline is a VOP node-var then it is used to make an appropriate
|
||||
speed vs size decision."
|
||||
(flet ((load-size (dst-tn size)
|
||||
(unless (and (tn-p size) (location= alloc-tn size))
|
||||
(inst mov dst-tn size))))
|
||||
|
|
@ -271,7 +269,6 @@
|
|||
(inst lea ,result-tn
|
||||
(make-ea :byte :base ,result-tn :disp other-pointer-type))
|
||||
,@forms))
|
||||
|
||||
|
||||
;;;; error code
|
||||
|
||||
|
|
|
|||
|
|
@ -131,7 +131,7 @@ alloc_sap(void *ptr)
|
|||
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);
|
||||
(struct sap *)alloc_unboxed((int)type_Sap, n_words_to_alloc);
|
||||
sap->pointer = ptr;
|
||||
return (lispobj) sap | type_OtherPointer;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -42,5 +42,3 @@ typedef struct sigcontext os_context_t;
|
|||
#define OS_VM_PROT_READ PROT_READ
|
||||
#define OS_VM_PROT_WRITE PROT_WRITE
|
||||
#define OS_VM_PROT_EXECUTE PROT_EXEC
|
||||
|
||||
#define OS_VM_DEFAULT_PAGESIZE 4096
|
||||
|
|
|
|||
|
|
@ -88,8 +88,10 @@ process_directory(int fd, long *ptr, int count)
|
|||
#else
|
||||
dynamic_space_free_pointer = free_pointer;
|
||||
#endif
|
||||
/* With GENCGC, this will always be space 0. (We checked
|
||||
* above that addr==DYNAMIC_SPACE_START.) */
|
||||
/* For stop-and-copy GC, this will be whatever the GC was
|
||||
* using at the time. With GENCGC, this will always be
|
||||
* space 0. (We checked above that for GENCGC,
|
||||
* addr==DYNAMIC_SPACE_START.) */
|
||||
current_dynamic_space = (lispobj *)addr;
|
||||
break;
|
||||
case STATIC_SPACE_ID:
|
||||
|
|
@ -137,7 +139,7 @@ load_core_file(char *file)
|
|||
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) {
|
||||
|
|
|
|||
|
|
@ -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 = 1;
|
||||
boolean gencgc_zero_check = 0;
|
||||
|
||||
/* Should we check that the free space is zero filled? */
|
||||
boolean gencgc_enable_verify_zero_fill = 1;
|
||||
boolean gencgc_enable_verify_zero_fill = 0;
|
||||
|
||||
/* Should we check that free pages are zero filled during gc_free_heap
|
||||
* called after Lisp PURIFY? */
|
||||
boolean gencgc_zero_check_during_free_heap = 1;
|
||||
boolean gencgc_zero_check_during_free_heap = 0;
|
||||
|
||||
/*
|
||||
* 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,12 +196,13 @@ struct generation {
|
|||
/* the first page that gc_alloc_unboxed checks on its next call */
|
||||
int alloc_unboxed_start_page;
|
||||
|
||||
/* the first page that we look at for boxed large allocations
|
||||
(Although we always allocate after the boxed_region.) */
|
||||
/* the first page that gc_alloc_large (boxed) considers on its next
|
||||
* call. (Although it always allocates after the boxed_region.) */
|
||||
int alloc_large_start_page;
|
||||
|
||||
/* the first page that we look at for unboxed large allocations
|
||||
* (Although we always allocate after the current_unboxed_region.) */
|
||||
/* the first page that gc_alloc_large (unboxed) considers on its
|
||||
* next call. (Although it always allocates after the
|
||||
* current_unboxed_region.) */
|
||||
int alloc_large_unboxed_start_page;
|
||||
|
||||
/* the bytes allocated to this generation */
|
||||
|
|
@ -459,94 +460,22 @@ 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;
|
||||
|
||||
/* Set *alloc_region to refer to a new region with room for at least
|
||||
* the given number of bytes.
|
||||
/* Find 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.
|
||||
*
|
||||
* We start by looking at the current generation's alloc_start_page. So
|
||||
* It starts 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.
|
||||
*
|
||||
|
|
@ -559,7 +488,8 @@ 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)
|
||||
{
|
||||
|
|
@ -571,13 +501,16 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region)
|
|||
int num_pages;
|
||||
int i;
|
||||
|
||||
/* 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);
|
||||
}
|
||||
/*
|
||||
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));
|
||||
|
||||
if (unboxed) {
|
||||
restart_page =
|
||||
|
|
@ -609,8 +542,7 @@ 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);
|
||||
|
|
@ -708,11 +640,10 @@ 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);
|
||||
|
||||
|
|
@ -737,9 +668,6 @@ 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
|
||||
|
|
@ -834,13 +762,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 may be added to
|
||||
/* Update the tables for the alloc_region. The region maybe added to
|
||||
* the new_areas.
|
||||
*
|
||||
* 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. */
|
||||
* 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. */
|
||||
void
|
||||
gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
|
||||
{
|
||||
|
|
@ -864,25 +792,15 @@ 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. */
|
||||
|
||||
|
|
@ -891,22 +809,19 @@ 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;
|
||||
|
||||
/* Calculate the number of bytes used in this page. This is
|
||||
not always the number of new bytes, unless it was free. */
|
||||
/* Calc. the number of bytes used in this page. This is not always
|
||||
the number of new bytes, unless it was free. */
|
||||
more = 0;
|
||||
bytes_used =
|
||||
alloc_region->free_pointer - page_address(first_page);
|
||||
if (bytes_used > 4096) {
|
||||
if ((bytes_used = (alloc_region->free_pointer - page_address(first_page)))>4096) {
|
||||
bytes_used = 4096;
|
||||
more = 1;
|
||||
}
|
||||
|
|
@ -914,7 +829,7 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
|
|||
byte_cnt += bytes_used;
|
||||
|
||||
|
||||
/* All the rest of the pages should be free. We need to set their
|
||||
/* All the rest of the pages should be free. Need to set their
|
||||
first_object_offset pointer to the start of the region, and set
|
||||
the bytes_used. */
|
||||
while (more) {
|
||||
|
|
@ -930,14 +845,9 @@ 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;
|
||||
bytes_used =
|
||||
alloc_region->free_pointer - page_address(next_page);
|
||||
if (bytes_used > 4096) {
|
||||
if ((bytes_used = (alloc_region->free_pointer
|
||||
- page_address(next_page)))>4096) {
|
||||
bytes_used = 4096;
|
||||
more = 1;
|
||||
}
|
||||
|
|
@ -947,26 +857,23 @@ 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,
|
||||
|
|
@ -974,12 +881,12 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
|
|||
region_size,
|
||||
gc_alloc_generation));
|
||||
*/
|
||||
} else {
|
||||
/* No bytes were allocated. Unallocate the first_page if there
|
||||
* are 0 bytes_used. */
|
||||
}
|
||||
else
|
||||
/* No bytes 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) {
|
||||
|
|
@ -988,16 +895,19 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
|
|||
next_page++;
|
||||
}
|
||||
|
||||
reset_alloc_region(alloc_region);
|
||||
/* 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);
|
||||
}
|
||||
|
||||
static inline void *gc_quick_alloc(int nbytes);
|
||||
|
||||
/* Allocate a possibly large object. */
|
||||
static void *
|
||||
gc_alloc_possibly_large(int nbytes,
|
||||
int unboxed,
|
||||
struct alloc_region *alloc_region)
|
||||
static void
|
||||
*gc_alloc_large(int nbytes, int unboxed, struct alloc_region *alloc_region)
|
||||
{
|
||||
int first_page;
|
||||
int last_page;
|
||||
|
|
@ -1019,14 +929,14 @@ gc_alloc_possibly_large(int nbytes,
|
|||
|
||||
/*
|
||||
FSHOW((stderr,
|
||||
"/gc_alloc_possibly_large for %d bytes (large=%d) from gen %d\n",
|
||||
nbytes, large, gc_alloc_generation));
|
||||
"/gc_alloc_large for %d bytes from gen %d\n",
|
||||
nbytes, 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
|
||||
|
|
@ -1039,8 +949,7 @@ gc_alloc_possibly_large(int nbytes,
|
|||
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)
|
||||
|
|
@ -1069,8 +978,7 @@ gc_alloc_possibly_large(int nbytes,
|
|||
|
||||
if (first_page >= NUM_PAGES) {
|
||||
fprintf(stderr,
|
||||
"Argh! gc_alloc_possibly_large failed (first_page), "
|
||||
"nbytes=%d.\n",
|
||||
"Argh! gc_alloc_large failed (first_page), nbytes=%d.\n",
|
||||
nbytes);
|
||||
print_generation_stats(1);
|
||||
lose(NULL);
|
||||
|
|
@ -1113,8 +1021,7 @@ gc_alloc_possibly_large(int nbytes,
|
|||
/* Check for a failure */
|
||||
if ((restart_page >= NUM_PAGES) && (bytes_found < nbytes)) {
|
||||
fprintf(stderr,
|
||||
"Argh! gc_alloc_possibly_large failed (restart_page), "
|
||||
"nbytes=%d.\n",
|
||||
"Argh! gc_alloc_large failed (restart_page), nbytes=%d.\n",
|
||||
nbytes);
|
||||
print_generation_stats(1);
|
||||
lose(NULL);
|
||||
|
|
@ -1123,7 +1030,7 @@ gc_alloc_possibly_large(int nbytes,
|
|||
/*
|
||||
if (large)
|
||||
FSHOW((stderr,
|
||||
"/gc_alloc_possibly_large gen %d: %d of %d bytes: from pages %d to %d: addr=%x\n",
|
||||
"/gc_alloc_large gen %d: %d of %d bytes: from pages %d to %d: addr=%x\n",
|
||||
gc_alloc_generation,
|
||||
nbytes,
|
||||
bytes_found,
|
||||
|
|
@ -1227,8 +1134,8 @@ gc_alloc_possibly_large(int nbytes,
|
|||
/* 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;
|
||||
|
||||
|
|
@ -1258,7 +1165,7 @@ gc_alloc(int nbytes)
|
|||
* 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_possibly_large(nbytes, 0, &boxed_region);
|
||||
return gc_alloc_large(nbytes, 0, &boxed_region);
|
||||
|
||||
/* Else find a new region. */
|
||||
|
||||
|
|
@ -1298,8 +1205,8 @@ gc_alloc(int nbytes)
|
|||
/* 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;
|
||||
|
||||
|
|
@ -1313,21 +1220,21 @@ gc_quick_alloc(int nbytes)
|
|||
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_possibly_large(nbytes, 0, &boxed_region);
|
||||
return gc_alloc_large(nbytes, 0, &boxed_region);
|
||||
|
||||
/* Check whether there is room in the current region. */
|
||||
new_free_pointer = boxed_region.free_pointer + nbytes;
|
||||
|
|
@ -1343,8 +1250,8 @@ gc_quick_alloc_large(int nbytes)
|
|||
return (gc_alloc(nbytes));
|
||||
}
|
||||
|
||||
static void *
|
||||
gc_alloc_unboxed(int nbytes)
|
||||
static void
|
||||
*gc_alloc_unboxed(int nbytes)
|
||||
{
|
||||
void *new_free_pointer;
|
||||
|
||||
|
|
@ -1377,7 +1284,7 @@ gc_alloc_unboxed(int nbytes)
|
|||
/* 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_possibly_large(nbytes,1,&unboxed_region);
|
||||
return gc_alloc_large(nbytes,1,&unboxed_region);
|
||||
|
||||
/* Else find a new region. */
|
||||
|
||||
|
|
@ -1414,8 +1321,8 @@ gc_alloc_unboxed(int nbytes)
|
|||
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;
|
||||
|
||||
|
|
@ -1439,13 +1346,13 @@ gc_quick_alloc_unboxed(int nbytes)
|
|||
* 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_unboxed_possibly_large(int nbytes)
|
||||
static inline void
|
||||
*gc_quick_alloc_large_unboxed(int nbytes)
|
||||
{
|
||||
void *new_free_pointer;
|
||||
|
||||
if (nbytes >= large_object_size)
|
||||
return gc_alloc_possibly_large(nbytes,1,&unboxed_region);
|
||||
return gc_alloc_large(nbytes,1,&unboxed_region);
|
||||
|
||||
/* Check whether there is room in the current region. */
|
||||
new_free_pointer = unboxed_region.free_pointer + nbytes;
|
||||
|
|
@ -1815,7 +1722,7 @@ copy_large_unboxed_object(lispobj object, int nwords)
|
|||
tag = LowtagOf(object);
|
||||
|
||||
/* Allocate space. */
|
||||
new = gc_quick_alloc_unboxed_possibly_large(nwords*4);
|
||||
new = gc_quick_alloc_large_unboxed(nwords*4);
|
||||
|
||||
dest = new;
|
||||
source = (lispobj *) PTR(object);
|
||||
|
|
@ -1855,7 +1762,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 */
|
||||
|
||||
|
|
@ -2028,7 +1935,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;
|
||||
}
|
||||
|
||||
|
|
@ -3121,7 +3028,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) {
|
||||
|
|
@ -3757,7 +3664,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 */
|
||||
|
|
@ -4299,7 +4206,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;
|
||||
|
||||
|
|
@ -4310,14 +4217,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;
|
||||
|
||||
|
|
@ -4397,7 +4304,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;
|
||||
}
|
||||
|
|
@ -4621,7 +4528,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;
|
||||
}
|
||||
|
|
@ -4718,7 +4625,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++) {
|
||||
|
|
@ -5046,7 +4953,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",
|
||||
|
|
@ -5113,7 +5020,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) {
|
||||
|
|
@ -5180,7 +5087,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));*/
|
||||
}
|
||||
|
||||
|
|
@ -5323,7 +5230,6 @@ 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)
|
||||
|
|
@ -5351,7 +5257,6 @@ print_ptr(lispobj *addr)
|
|||
*(addr+3),
|
||||
*(addr+4));
|
||||
}
|
||||
#endif
|
||||
|
||||
extern int undefined_tramp;
|
||||
|
||||
|
|
@ -5641,6 +5546,20 @@ 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)
|
||||
{
|
||||
|
|
@ -5859,7 +5778,8 @@ garbage_collect_generation(int generation, int raise)
|
|||
generations[generation].alloc_large_unboxed_start_page = 0;
|
||||
|
||||
if (generation >= verify_gens) {
|
||||
SHOW("verifying");
|
||||
if (gencgc_verbose)
|
||||
SHOW("verifying");
|
||||
verify_gc();
|
||||
verify_dynamic_space();
|
||||
}
|
||||
|
|
@ -5869,11 +5789,10 @@ 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 */
|
||||
|
|
@ -5883,25 +5802,15 @@ 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 ... */
|
||||
}
|
||||
|
||||
|
|
@ -5921,11 +5830,6 @@ 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));
|
||||
|
|
@ -5943,7 +5847,7 @@ collect_garbage(unsigned last_gen)
|
|||
|
||||
/* Verify the new objects created by Lisp code. */
|
||||
if (pre_verify_gen_0) {
|
||||
SHOW("pre-checking generation 0\n");
|
||||
SHOW((stderr, "pre-checking generation 0\n"));
|
||||
verify_generation(0);
|
||||
}
|
||||
|
||||
|
|
@ -5964,7 +5868,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,
|
||||
|
|
@ -5985,7 +5889,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);
|
||||
}
|
||||
|
||||
|
|
@ -6112,10 +6016,19 @@ gc_free_heap(void)
|
|||
if (gencgc_verbose > 1)
|
||||
print_generation_stats(0);
|
||||
|
||||
/* Initialize gc_alloc(). */
|
||||
/* Initialize gc_alloc */
|
||||
gc_alloc_generation = 0;
|
||||
reset_alloc_region(&boxed_region);
|
||||
reset_alloc_region(&unboxed_region);
|
||||
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);
|
||||
|
||||
#if 0 /* Lisp PURIFY is currently running on the C stack so don't do this. */
|
||||
zero_stack();
|
||||
|
|
@ -6129,7 +6042,8 @@ gc_free_heap(void)
|
|||
|
||||
if (verify_after_free_heap) {
|
||||
/* Check whether purify has left any bad pointers. */
|
||||
SHOW("checking after free_heap\n");
|
||||
if (gencgc_verbose)
|
||||
SHOW("checking after free_heap\n");
|
||||
verify_gc();
|
||||
}
|
||||
}
|
||||
|
|
@ -6203,8 +6117,6 @@ 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;
|
||||
|
|
@ -6222,8 +6134,6 @@ 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 */
|
||||
|
|
@ -6443,12 +6353,9 @@ 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=0x%0lx, page_index=%d\n",
|
||||
(unsigned long)fault_addr, page_index));
|
||||
FSHOW((stderr, "heap WP violation? fault_addr=%x, page_index=%d\n",
|
||||
fault_addr, page_index));
|
||||
#endif
|
||||
|
||||
/* Check whether the fault is within the dynamic space. */
|
||||
|
|
|
|||
|
|
@ -44,12 +44,7 @@ lispobj *current_auto_gc_trigger;
|
|||
/* For copying GCs, this points to the start of the dynamic space
|
||||
* currently in use (that will become the from_space when the next GC
|
||||
* is done). For the GENCGC, it always points to DYNAMIC_SPACE_START. */
|
||||
lispobj *current_dynamic_space =
|
||||
#ifndef GENCGC
|
||||
DYNAMIC_0_SPACE_START;
|
||||
#else
|
||||
DYNAMIC_SPACE_START;
|
||||
#endif
|
||||
lispobj *current_dynamic_space;
|
||||
|
||||
void globals_init(void)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -84,15 +84,15 @@ int n_do_mmap_ignorable_errors = 3;
|
|||
static int
|
||||
do_mmap(os_vm_address_t *addr, os_vm_size_t len, int flags)
|
||||
{
|
||||
/* We *must* have the memory where we want it. */
|
||||
os_vm_address_t old_addr=*addr;
|
||||
/* We *must* have the memory where we expect it. */
|
||||
os_vm_address_t old_addr = *addr;
|
||||
|
||||
*addr = mmap(*addr, len, OS_VM_PROT_ALL, flags, -1, 0);
|
||||
if (*addr == MAP_FAILED ||
|
||||
((old_addr != NULL) && (*addr != old_addr))) {
|
||||
FSHOW((stderr,
|
||||
"/error in allocating memory from the OS\n"
|
||||
"(addr=%lx, len=%lx, flags=%lx)\n",
|
||||
"/retryable error in allocating memory from the OS\n"
|
||||
"(addr=0x%lx, len=0x%lx, flags=0x%lx)\n",
|
||||
(long) addr,
|
||||
(long) len,
|
||||
(long) flags));
|
||||
|
|
|
|||
|
|
@ -28,11 +28,6 @@
|
|||
* os_vm_prot_t
|
||||
* type used for flags for mmap, mprotect, etc.
|
||||
*
|
||||
* OS_VM_DEFAULT_PAGESIZE
|
||||
* used by core dumping and loading logic (but dunno its exact
|
||||
* definition, in particular why we can't just use getpagesize()
|
||||
* instead)
|
||||
*
|
||||
* os_vm_address_t
|
||||
* the type used to represent addresses? (dunno why not just void*)
|
||||
* os_vm_size_t, os_vm_off_t
|
||||
|
|
|
|||
|
|
@ -117,77 +117,77 @@ dynamic_pointer_p(lispobj ptr)
|
|||
static int
|
||||
maybe_can_move_p(lispobj thing)
|
||||
{
|
||||
lispobj *thingp,header;
|
||||
if (dynamic_pointer_p(thing)) { /* in dynamic space */
|
||||
thingp = (lispobj*)PTR(thing);
|
||||
header = *thingp;
|
||||
if(Pointerp(header) && forwarding_pointer_p(header))
|
||||
return -1; /* must change it */
|
||||
if(LowtagOf(thing) == type_ListPointer)
|
||||
return type_ListPointer; /* can we check this somehow */
|
||||
else if (thing & 3) { /* not fixnum */
|
||||
int kind = TypeOf(header);
|
||||
/* printf(" %x %x",header,kind); */
|
||||
switch (kind) { /* something with a header */
|
||||
case type_Bignum:
|
||||
case type_SingleFloat:
|
||||
case type_DoubleFloat:
|
||||
lispobj *thingp,header;
|
||||
if (dynamic_pointer_p(thing)) { /* in dynamic space */
|
||||
thingp = (lispobj*)PTR(thing);
|
||||
header = *thingp;
|
||||
if(Pointerp(header) && forwarding_pointer_p(header))
|
||||
return -1; /* must change it */
|
||||
if(LowtagOf(thing) == type_ListPointer)
|
||||
return type_ListPointer; /* can we check this somehow */
|
||||
else if (thing & 3) { /* not fixnum */
|
||||
int kind = TypeOf(header);
|
||||
/* printf(" %x %x",header,kind); */
|
||||
switch (kind) { /* something with a header */
|
||||
case type_Bignum:
|
||||
case type_SingleFloat:
|
||||
case type_DoubleFloat:
|
||||
#ifdef type_LongFloat
|
||||
case type_LongFloat:
|
||||
case type_LongFloat:
|
||||
#endif
|
||||
case type_Sap:
|
||||
case type_SimpleVector:
|
||||
case type_SimpleString:
|
||||
case type_SimpleBitVector:
|
||||
case type_SimpleArrayUnsignedByte2:
|
||||
case type_SimpleArrayUnsignedByte4:
|
||||
case type_SimpleArrayUnsignedByte8:
|
||||
case type_SimpleArrayUnsignedByte16:
|
||||
case type_SimpleArrayUnsignedByte32:
|
||||
case type_Sap:
|
||||
case type_SimpleVector:
|
||||
case type_SimpleString:
|
||||
case type_SimpleBitVector:
|
||||
case type_SimpleArrayUnsignedByte2:
|
||||
case type_SimpleArrayUnsignedByte4:
|
||||
case type_SimpleArrayUnsignedByte8:
|
||||
case type_SimpleArrayUnsignedByte16:
|
||||
case type_SimpleArrayUnsignedByte32:
|
||||
#ifdef type_SimpleArraySignedByte8
|
||||
case type_SimpleArraySignedByte8:
|
||||
case type_SimpleArraySignedByte8:
|
||||
#endif
|
||||
#ifdef type_SimpleArraySignedByte16
|
||||
case type_SimpleArraySignedByte16:
|
||||
case type_SimpleArraySignedByte16:
|
||||
#endif
|
||||
#ifdef type_SimpleArraySignedByte30
|
||||
case type_SimpleArraySignedByte30:
|
||||
case type_SimpleArraySignedByte30:
|
||||
#endif
|
||||
#ifdef type_SimpleArraySignedByte32
|
||||
case type_SimpleArraySignedByte32:
|
||||
case type_SimpleArraySignedByte32:
|
||||
#endif
|
||||
case type_SimpleArraySingleFloat:
|
||||
case type_SimpleArrayDoubleFloat:
|
||||
case type_SimpleArraySingleFloat:
|
||||
case type_SimpleArrayDoubleFloat:
|
||||
#ifdef type_SimpleArrayLongFloat
|
||||
case type_SimpleArrayLongFloat:
|
||||
case type_SimpleArrayLongFloat:
|
||||
#endif
|
||||
#ifdef type_SimpleArrayComplexSingleFloat
|
||||
case type_SimpleArrayComplexSingleFloat:
|
||||
case type_SimpleArrayComplexSingleFloat:
|
||||
#endif
|
||||
#ifdef type_SimpleArrayComplexDoubleFloat
|
||||
case type_SimpleArrayComplexDoubleFloat:
|
||||
case type_SimpleArrayComplexDoubleFloat:
|
||||
#endif
|
||||
#ifdef type_SimpleArrayComplexLongFloat
|
||||
case type_SimpleArrayComplexLongFloat:
|
||||
case type_SimpleArrayComplexLongFloat:
|
||||
#endif
|
||||
case type_CodeHeader:
|
||||
case type_FunctionHeader:
|
||||
case type_ClosureFunctionHeader:
|
||||
case type_ReturnPcHeader:
|
||||
case type_ClosureHeader:
|
||||
case type_FuncallableInstanceHeader:
|
||||
case type_InstanceHeader:
|
||||
case type_ValueCellHeader:
|
||||
case type_ByteCodeFunction:
|
||||
case type_ByteCodeClosure:
|
||||
case type_WeakPointer:
|
||||
case type_Fdefn:
|
||||
return kind;
|
||||
break;
|
||||
default:
|
||||
return 0;
|
||||
}}}
|
||||
return 0;
|
||||
case type_CodeHeader:
|
||||
case type_FunctionHeader:
|
||||
case type_ClosureFunctionHeader:
|
||||
case type_ReturnPcHeader:
|
||||
case type_ClosureHeader:
|
||||
case type_FuncallableInstanceHeader:
|
||||
case type_InstanceHeader:
|
||||
case type_ValueCellHeader:
|
||||
case type_ByteCodeFunction:
|
||||
case type_ByteCodeClosure:
|
||||
case type_WeakPointer:
|
||||
case type_Fdefn:
|
||||
return kind;
|
||||
break;
|
||||
default:
|
||||
return 0;
|
||||
}}}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int pverbose=0;
|
||||
|
|
@ -270,7 +270,7 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr)
|
|||
(unsigned int) start_addr, *start_addr);
|
||||
return 0;
|
||||
}
|
||||
/* Is it a plausible cons? */
|
||||
/* Is it plausible cons? */
|
||||
if((Pointerp(start_addr[0])
|
||||
|| ((start_addr[0] & 3) == 0) /* fixnum */
|
||||
|| (TypeOf(start_addr[0]) == type_BaseChar)
|
||||
|
|
@ -444,61 +444,60 @@ unsigned int num_valid_stack_ra_locations;
|
|||
static void
|
||||
setup_i386_stack_scav(lispobj *lowaddr, lispobj *base)
|
||||
{
|
||||
lispobj *sp = lowaddr;
|
||||
num_valid_stack_locations = 0;
|
||||
num_valid_stack_ra_locations = 0;
|
||||
for (sp = lowaddr; sp < base; sp++) {
|
||||
lispobj thing = *sp;
|
||||
/* Find the object start address */
|
||||
lispobj *start_addr = search_dynamic_space((void *)thing);
|
||||
if (start_addr) {
|
||||
/* We need to allow raw pointers into Code objects for
|
||||
* return addresses. This will also pick up pointers to
|
||||
* functions in code objects. */
|
||||
if (TypeOf(*start_addr) == type_CodeHeader) {
|
||||
gc_assert(num_valid_stack_ra_locations <
|
||||
MAX_STACK_RETURN_ADDRESSES);
|
||||
valid_stack_ra_locations[num_valid_stack_ra_locations] = sp;
|
||||
valid_stack_ra_code_objects[num_valid_stack_ra_locations++] =
|
||||
(lispobj *)((int)start_addr + type_OtherPointer);
|
||||
} else {
|
||||
if (valid_dynamic_space_pointer((void *)thing, start_addr)) {
|
||||
gc_assert(num_valid_stack_locations < MAX_STACK_POINTERS);
|
||||
valid_stack_locations[num_valid_stack_locations++] = sp;
|
||||
}
|
||||
}
|
||||
lispobj *sp = lowaddr;
|
||||
num_valid_stack_locations = 0;
|
||||
num_valid_stack_ra_locations = 0;
|
||||
for (sp = lowaddr; sp < base; sp++) {
|
||||
lispobj thing = *sp;
|
||||
/* Find the object start address */
|
||||
lispobj *start_addr = search_dynamic_space((void *)thing);
|
||||
if (start_addr) {
|
||||
/* We need to allow raw pointers into Code objects for return
|
||||
* addresses. This will also pick up pointers to functions in code
|
||||
* objects. */
|
||||
if (TypeOf(*start_addr) == type_CodeHeader) {
|
||||
gc_assert(num_valid_stack_ra_locations < MAX_STACK_RETURN_ADDRESSES);
|
||||
valid_stack_ra_locations[num_valid_stack_ra_locations] = sp;
|
||||
valid_stack_ra_code_objects[num_valid_stack_ra_locations++] =
|
||||
(lispobj *)((int)start_addr + type_OtherPointer);
|
||||
} else {
|
||||
if (valid_dynamic_space_pointer((void *)thing, start_addr)) {
|
||||
gc_assert(num_valid_stack_locations < MAX_STACK_POINTERS);
|
||||
valid_stack_locations[num_valid_stack_locations++] = sp;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (pointer_filter_verbose) {
|
||||
fprintf(stderr, "number of valid stack pointers = %d\n",
|
||||
num_valid_stack_locations);
|
||||
fprintf(stderr, "number of stack return addresses = %d\n",
|
||||
num_valid_stack_ra_locations);
|
||||
}
|
||||
}
|
||||
if (pointer_filter_verbose) {
|
||||
fprintf(stderr, "number of valid stack pointers = %d\n",
|
||||
num_valid_stack_locations);
|
||||
fprintf(stderr, "number of stack return addresses = %d\n",
|
||||
num_valid_stack_ra_locations);
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
pscav_i386_stack(void)
|
||||
{
|
||||
int i;
|
||||
int i;
|
||||
|
||||
for (i = 0; i < num_valid_stack_locations; i++)
|
||||
pscav(valid_stack_locations[i], 1, 0);
|
||||
for (i = 0; i < num_valid_stack_locations; i++)
|
||||
pscav(valid_stack_locations[i], 1, 0);
|
||||
|
||||
for (i = 0; i < num_valid_stack_ra_locations; i++) {
|
||||
lispobj code_obj = (lispobj)valid_stack_ra_code_objects[i];
|
||||
pscav(&code_obj, 1, 0);
|
||||
if (pointer_filter_verbose) {
|
||||
fprintf(stderr,"*C moved RA %x to %x; for code object %x to %x\n",
|
||||
*valid_stack_ra_locations[i],
|
||||
(int)(*valid_stack_ra_locations[i])
|
||||
- ((int)valid_stack_ra_code_objects[i] - (int)code_obj),
|
||||
(unsigned int) valid_stack_ra_code_objects[i], code_obj);
|
||||
}
|
||||
*valid_stack_ra_locations[i] =
|
||||
((int)(*valid_stack_ra_locations[i])
|
||||
- ((int)valid_stack_ra_code_objects[i] - (int)code_obj));
|
||||
for (i = 0; i < num_valid_stack_ra_locations; i++) {
|
||||
lispobj code_obj = (lispobj)valid_stack_ra_code_objects[i];
|
||||
pscav(&code_obj, 1, 0);
|
||||
if (pointer_filter_verbose) {
|
||||
fprintf(stderr,"*C moved RA %x to %x; for code object %x to %x\n",
|
||||
*valid_stack_ra_locations[i],
|
||||
(int)(*valid_stack_ra_locations[i])
|
||||
- ((int)valid_stack_ra_code_objects[i] - (int)code_obj),
|
||||
(unsigned int) valid_stack_ra_code_objects[i], code_obj);
|
||||
}
|
||||
*valid_stack_ra_locations[i] =
|
||||
((int)(*valid_stack_ra_locations[i])
|
||||
- ((int)valid_stack_ra_code_objects[i] - (int)code_obj));
|
||||
}
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
|
@ -533,8 +532,7 @@ pscav_later(lispobj *where, int count)
|
|||
}
|
||||
}
|
||||
|
||||
static lispobj
|
||||
ptrans_boxed(lispobj thing, lispobj header, boolean constant)
|
||||
static lispobj ptrans_boxed(lispobj thing, lispobj header, boolean constant)
|
||||
{
|
||||
int nwords;
|
||||
lispobj result, *new, *old;
|
||||
|
|
@ -566,10 +564,9 @@ ptrans_boxed(lispobj thing, lispobj header, boolean constant)
|
|||
}
|
||||
|
||||
/* We need to look at the layout to see whether it is a pure structure
|
||||
* class, and only then can we transport as constant. If it is pure,
|
||||
* we can ALWAYS transport as a constant. */
|
||||
static lispobj
|
||||
ptrans_instance(lispobj thing, lispobj header, boolean constant)
|
||||
* class, and only then can we transport as constant. If it is pure, we can
|
||||
* ALWAYS transport as a constant. */
|
||||
static lispobj ptrans_instance(lispobj thing, lispobj header, boolean constant)
|
||||
{
|
||||
lispobj layout = ((struct instance *)PTR(thing))->slots[0];
|
||||
lispobj pure = ((struct instance *)PTR(layout))->slots[15];
|
||||
|
|
@ -613,8 +610,7 @@ ptrans_instance(lispobj thing, lispobj header, boolean constant)
|
|||
}
|
||||
}
|
||||
|
||||
static lispobj
|
||||
ptrans_fdefn(lispobj thing, lispobj header)
|
||||
static lispobj ptrans_fdefn(lispobj thing, lispobj header)
|
||||
{
|
||||
int nwords;
|
||||
lispobj result, *new, *old, oldfn;
|
||||
|
|
@ -644,8 +640,7 @@ ptrans_fdefn(lispobj thing, lispobj header)
|
|||
return result;
|
||||
}
|
||||
|
||||
static lispobj
|
||||
ptrans_unboxed(lispobj thing, lispobj header)
|
||||
static lispobj ptrans_unboxed(lispobj thing, lispobj header)
|
||||
{
|
||||
int nwords;
|
||||
lispobj result, *new, *old;
|
||||
|
|
@ -667,9 +662,8 @@ ptrans_unboxed(lispobj thing, lispobj header)
|
|||
return result;
|
||||
}
|
||||
|
||||
static lispobj
|
||||
ptrans_vector(lispobj thing, int bits, int extra,
|
||||
boolean boxed, boolean constant)
|
||||
static lispobj ptrans_vector(lispobj thing, int bits, int extra,
|
||||
boolean boxed, boolean constant)
|
||||
{
|
||||
struct vector *vector;
|
||||
int nwords;
|
||||
|
|
@ -783,8 +777,7 @@ apply_code_fixups_during_purify(struct code *old_code, struct code *new_code)
|
|||
}
|
||||
#endif
|
||||
|
||||
static lispobj
|
||||
ptrans_code(lispobj thing)
|
||||
static lispobj ptrans_code(lispobj thing)
|
||||
{
|
||||
struct code *code, *new;
|
||||
int nwords;
|
||||
|
|
@ -853,8 +846,7 @@ ptrans_code(lispobj thing)
|
|||
return result;
|
||||
}
|
||||
|
||||
static lispobj
|
||||
ptrans_func(lispobj thing, lispobj header)
|
||||
static lispobj ptrans_func(lispobj thing, lispobj header)
|
||||
{
|
||||
int nwords;
|
||||
lispobj code, *new, *old, result;
|
||||
|
|
@ -916,8 +908,7 @@ ptrans_func(lispobj thing, lispobj header)
|
|||
}
|
||||
}
|
||||
|
||||
static lispobj
|
||||
ptrans_returnpc(lispobj thing, lispobj header)
|
||||
static lispobj ptrans_returnpc(lispobj thing, lispobj header)
|
||||
{
|
||||
lispobj code, new;
|
||||
|
||||
|
|
@ -935,8 +926,7 @@ ptrans_returnpc(lispobj thing, lispobj header)
|
|||
|
||||
#define WORDS_PER_CONS CEILING(sizeof(struct cons) / sizeof(lispobj), 2)
|
||||
|
||||
static lispobj
|
||||
ptrans_list(lispobj thing, boolean constant)
|
||||
static lispobj ptrans_list(lispobj thing, boolean constant)
|
||||
{
|
||||
struct cons *old, *new, *orig;
|
||||
int length;
|
||||
|
|
@ -978,8 +968,7 @@ ptrans_list(lispobj thing, boolean constant)
|
|||
return ((lispobj)orig) | type_ListPointer;
|
||||
}
|
||||
|
||||
static lispobj
|
||||
ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
|
||||
static lispobj ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
|
||||
{
|
||||
switch (TypeOf(header)) {
|
||||
case type_Bignum:
|
||||
|
|
@ -1103,8 +1092,7 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
|
|||
}
|
||||
}
|
||||
|
||||
static int
|
||||
pscav_fdefn(struct fdefn *fdefn)
|
||||
static int pscav_fdefn(struct fdefn *fdefn)
|
||||
{
|
||||
boolean fix_func;
|
||||
|
||||
|
|
@ -1168,8 +1156,7 @@ pscav_code(struct code*code)
|
|||
}
|
||||
#endif
|
||||
|
||||
static lispobj *
|
||||
pscav(lispobj *addr, int nwords, boolean constant)
|
||||
static lispobj *pscav(lispobj *addr, int nwords, boolean constant)
|
||||
{
|
||||
lispobj thing, *thingp, header;
|
||||
int count = 0; /* (0 = dummy init value to stop GCC warning) */
|
||||
|
|
@ -1390,8 +1377,7 @@ pscav(lispobj *addr, int nwords, boolean constant)
|
|||
return addr;
|
||||
}
|
||||
|
||||
int
|
||||
purify(lispobj static_roots, lispobj read_only_roots)
|
||||
int purify(lispobj static_roots, lispobj read_only_roots)
|
||||
{
|
||||
lispobj *clean;
|
||||
int count, i;
|
||||
|
|
@ -1466,9 +1452,8 @@ purify(lispobj static_roots, lispobj read_only_roots)
|
|||
fflush(stdout);
|
||||
#endif
|
||||
#if !defined(ibmrt) && !defined(__i386__)
|
||||
pscav((lispobj *)BINDING_STACK_START,
|
||||
(lispobj *)current_binding_stack_pointer
|
||||
- (lispobj *)BINDING_STACK_START,
|
||||
pscav( (lispobj *)BINDING_STACK_START,
|
||||
(lispobj *)current_binding_stack_pointer - (lispobj *)BINDING_STACK_START,
|
||||
0);
|
||||
#else
|
||||
pscav( (lispobj *)BINDING_STACK_START,
|
||||
|
|
@ -1480,13 +1465,13 @@ purify(lispobj static_roots, lispobj read_only_roots)
|
|||
#ifdef SCAVENGE_READ_ONLY_SPACE
|
||||
if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != type_UnboundMarker
|
||||
&& SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) {
|
||||
unsigned read_only_space_size =
|
||||
(lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER) -
|
||||
(lispobj *)READ_ONLY_SPACE_START;
|
||||
fprintf(stderr,
|
||||
"scavenging read only space: %d bytes\n",
|
||||
read_only_space_size * sizeof(lispobj));
|
||||
pscav( (lispobj *)READ_ONLY_SPACE_START, read_only_space_size, 0);
|
||||
unsigned read_only_space_size =
|
||||
(lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER) -
|
||||
(lispobj *)READ_ONLY_SPACE_START;
|
||||
fprintf(stderr,
|
||||
"scavenging read only space: %d bytes\n",
|
||||
read_only_space_size * sizeof(lispobj));
|
||||
pscav( (lispobj *)READ_ONLY_SPACE_START, read_only_space_size, 0);
|
||||
}
|
||||
#endif
|
||||
|
||||
|
|
@ -1547,23 +1532,23 @@ purify(lispobj static_roots, lispobj read_only_roots)
|
|||
|
||||
#if defined(WANT_CGC) && defined(STATIC_BLUE_BAG)
|
||||
{
|
||||
lispobj bag = SymbolValue(STATIC_BLUE_BAG);
|
||||
struct cons *cons = (struct cons*)static_free;
|
||||
struct cons *pair = cons + 1;
|
||||
static_free += 2 * WORDS_PER_CONS;
|
||||
if(bag == type_UnboundMarker)
|
||||
bag = NIL;
|
||||
cons->cdr = bag;
|
||||
cons->car = (lispobj)pair | type_ListPointer;
|
||||
pair->car = (lispobj)static_end;
|
||||
pair->cdr = (lispobj)static_free;
|
||||
bag = (lispobj)cons | type_ListPointer;
|
||||
SetSymbolValue(STATIC_BLUE_BAG, bag);
|
||||
lispobj bag = SymbolValue(STATIC_BLUE_BAG);
|
||||
struct cons*cons = (struct cons*)static_free;
|
||||
struct cons*pair = cons + 1;
|
||||
static_free += 2*WORDS_PER_CONS;
|
||||
if(bag == type_UnboundMarker)
|
||||
bag = NIL;
|
||||
cons->cdr = bag;
|
||||
cons->car = (lispobj)pair | type_ListPointer;
|
||||
pair->car = (lispobj)static_end;
|
||||
pair->cdr = (lispobj)static_free;
|
||||
bag = (lispobj)cons | type_ListPointer;
|
||||
SetSymbolValue(STATIC_BLUE_BAG, bag);
|
||||
}
|
||||
#endif
|
||||
|
||||
/* It helps to update the heap free pointers so that free_heap()
|
||||
* can verify after it's done. */
|
||||
/* It helps to update the heap free pointers so that free_heap can
|
||||
* verify after it's done. */
|
||||
SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free);
|
||||
SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free);
|
||||
|
||||
|
|
@ -1577,7 +1562,7 @@ purify(lispobj static_roots, lispobj read_only_roots)
|
|||
else
|
||||
cgc_free_heap();
|
||||
#else
|
||||
#if defined(GENCGC)
|
||||
#if defined GENCGC
|
||||
gc_free_heap();
|
||||
#else
|
||||
/* ibmrt using GC */
|
||||
|
|
|
|||
|
|
@ -68,8 +68,8 @@ output_space(FILE *file, int id, lispobj *addr, lispobj *end)
|
|||
|
||||
bytes = words * sizeof(lispobj);
|
||||
|
||||
printf("writing %ld(0x%lx) bytes from the %s(%d) space at 0x%08lx\n",
|
||||
(long)bytes, (long)bytes, names[id], id, (unsigned long)addr);
|
||||
printf("writing %d bytes from the %s space at 0x%08lx\n",
|
||||
bytes, names[id], (unsigned long)addr);
|
||||
|
||||
data = write_bytes(file, (char *)addr, bytes);
|
||||
|
||||
|
|
@ -97,9 +97,8 @@ save(char *filename, lispobj init_function)
|
|||
init_function = *func_ptr;
|
||||
/* Set dynamic space pointer to base value so we don't write out
|
||||
* MBs of just cleared heap. */
|
||||
if(SymbolValue(X86_CGC_ACTIVE_P) != NIL) {
|
||||
SetSymbolValue(ALLOCATION_POINTER, DYNAMIC_SPACE_START);
|
||||
}
|
||||
if(SymbolValue(X86_CGC_ACTIVE_P) != NIL)
|
||||
SetSymbolValue(ALLOCATION_POINTER, DYNAMIC_SPACE_START);
|
||||
#endif
|
||||
/* Open the file: */
|
||||
unlink(filename);
|
||||
|
|
@ -127,7 +126,7 @@ save(char *filename, lispobj init_function)
|
|||
putw(SBCL_CORE_VERSION_INTEGER, file);
|
||||
|
||||
putw(CORE_NDIRECTORY, file);
|
||||
putw((5*3)+2, file); /* 3 5-word space descriptors, plus code and count */
|
||||
putw((5*3)+2, file);
|
||||
|
||||
output_space(file, READ_ONLY_SPACE_ID, (lispobj *)READ_ONLY_SPACE_START,
|
||||
(lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
|
||||
|
|
@ -147,9 +146,6 @@ save(char *filename, lispobj init_function)
|
|||
(lispobj *)SymbolValue(ALLOCATION_POINTER));
|
||||
#endif
|
||||
|
||||
FSHOW((stderr, "/writing init_function=0x%lx\n", (long)init_function));
|
||||
FSHOW((stderr, "/(SymbolValue(ALLOCATION_POINTER)=0x%lx\n",
|
||||
(long)SymbolValue(ALLOCATION_POINTER)));
|
||||
putw(CORE_INITIAL_FUNCTION, file);
|
||||
putw(3, file);
|
||||
putw(init_function, file);
|
||||
|
|
|
|||
|
|
@ -76,6 +76,9 @@ validate(void)
|
|||
#ifdef HOLES
|
||||
make_holes();
|
||||
#endif
|
||||
#ifndef GENCGC
|
||||
current_dynamic_space = DYNAMIC_0_SPACE_START;
|
||||
#endif
|
||||
|
||||
#ifdef PRINTNOISE
|
||||
printf(" done.\n");
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@
|
|||
|
||||
# how we invoke SBCL in the tests
|
||||
export SBCL="${1:-../src/runtime/sbcl --core ../output/sbcl.core --noinform --sysinit /dev/null --userinit /dev/null --noprint --noprogrammer}"
|
||||
echo /running tests on SBCL=\'$SBCL\'
|
||||
|
||||
# "Ten four" is the closest numerical slang I can find to "OK", so
|
||||
# it's the Unix status value that we expect from a successful test.
|
||||
|
|
|
|||
|
|
@ -10,4 +10,4 @@
|
|||
all: grovel_headers
|
||||
|
||||
clean:
|
||||
-rm -f *.o grovel_headers
|
||||
rm -f *.o grovel_headers
|
||||
|
|
|
|||
|
|
@ -15,4 +15,4 @@
|
|||
;;; versions, and a string like "0.6.5.12" is used for versions which
|
||||
;;; aren't released but correspond only to CVS tags or snapshots.
|
||||
|
||||
"0.6.12.7.flaky1"
|
||||
"0.6.12.7.flaky1.1"
|
||||
|
|
|
|||
Loading…
Reference in a new issue