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
;;)
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
;; 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
;; 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
(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.
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
(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)))))
(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
;;; 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)
;;; 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)
(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))))
\f
;;;; time.h
;;; 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
;;; 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))))
(inst lea ,result-tn
(make-ea :byte :base ,result-tn :disp other-pointer-type))
,@forms))
-
\f
;;;; error code
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;
}
#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
#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:
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) {
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;
\f
/*
* GC structures and variables
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));
}
/* 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 */
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.
- *
- * 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.
+/* Find a new region with room for at least the given number of bytes.
*
- * 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.
*
* 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)
{
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 =
/* 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);
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);
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
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)
{
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. */
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;
}
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) {
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;
}
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,
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) {
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;
/*
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
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)
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);
/* 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);
/*
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,
/* 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;
* 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. */
/* 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;
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;
return (gc_alloc(nbytes));
}
-static void *
-gc_alloc_unboxed(int nbytes)
+static void
+*gc_alloc_unboxed(int nbytes)
{
void *new_free_pointer;
/* 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. */
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;
* 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;
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);
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 */
/* 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;
}
(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) {
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 */
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;
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;
default:
if (gencgc_verbose)
FSHOW((stderr,
- "/W?: %x %x %x\n",
+ "*W?: %x %x %x\n",
pointer, start_addr, *start_addr));
return 0;
}
|| (((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;
}
}
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++) {
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",
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) {
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));*/
}
return bytes_freed;
}
\f
-#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)
*(addr+3),
*(addr+4));
}
-#endif
extern int undefined_tramp;
}
}
+/* 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)
{
generations[generation].alloc_large_unboxed_start_page = 0;
if (generation >= verify_gens) {
- SHOW("verifying");
+ if (gencgc_verbose)
+ SHOW("verifying");
verify_gc();
verify_dynamic_space();
}
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 */
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 ... */
}
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));
/* 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);
}
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,
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);
}
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();
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();
}
}
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;
current_region_free_pointer = boxed_region.free_pointer;
current_region_end_addr = boxed_region.end_addr;
-
- SHOW("returning from gencgc_pickup_dynamic()");
}
\f
/* a counter for how deep we are in alloc(..) calls */
{
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. */
/* 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)
{
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));
* 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
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:
-#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_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:
#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:
-#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_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;
}
static int pverbose=0;
(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)
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
}
}
-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;
}
/* 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];
}
}
-static lispobj
-ptrans_fdefn(lispobj thing, lispobj header)
+static lispobj ptrans_fdefn(lispobj thing, lispobj header)
{
int nwords;
lispobj result, *new, *old, oldfn;
return result;
}
-static lispobj
-ptrans_unboxed(lispobj thing, lispobj header)
+static lispobj ptrans_unboxed(lispobj thing, lispobj header)
{
int nwords;
lispobj result, *new, *old;
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;
}
#endif
-static lispobj
-ptrans_code(lispobj thing)
+static lispobj ptrans_code(lispobj thing)
{
struct code *code, *new;
int nwords;
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;
}
}
-static lispobj
-ptrans_returnpc(lispobj thing, lispobj header)
+static lispobj ptrans_returnpc(lispobj thing, lispobj header)
{
lispobj code, new;
#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;
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:
}
}
-static int
-pscav_fdefn(struct fdefn *fdefn)
+static int pscav_fdefn(struct fdefn *fdefn)
{
boolean fix_func;
}
#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) */
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;
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,
#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
#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);
else
cgc_free_heap();
#else
-#if defined(GENCGC)
+#if defined GENCGC
gc_free_heap();
#else
/* ibmrt using GC */
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);
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);
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));
(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);
#ifdef HOLES
make_holes();
#endif
+#ifndef GENCGC
+ current_dynamic_space = DYNAMIC_0_SPACE_START;
+#endif
#ifdef PRINTNOISE
printf(" done.\n");
# 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.
all: grovel_headers
clean:
- -rm -f *.o grovel_headers
+ rm -f *.o grovel_headers
;;; 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"
projects / sbcl.git / commitdiff