(< sb!vm:static-space-start val
(* sb!vm:*static-space-free-pointer*
sb!vm:word-bytes))
- (< (sb!vm:dynamic-space-start) val
+ (< sb!vm:dynamic-space-start val
(sap-int (dynamic-space-free-pointer))))))
(make-lisp-obj val)
:invalid-object))
(def-c-var-frob sb!vm:control-stack-start "control_stack")
#!+x86 (def-c-var-frob control-stack-end "control_stack_end")
-(def-c-var-frob sb!vm:binding-stack-start "binding_stack")
#!-sb-fluid (declaim (inline dynamic-usage))
(def-c-var-frob dynamic-usage "bytes_allocated")
(defun write-c-header ()
+ ;; writing beginning boilerplate
(format t "/*~%")
(dolist (line
'("This is a machine-generated file. Do not edit it by hand."
(format t " * ~A~%" line))
(format t " */~%")
(terpri)
-
(format t "#ifndef _SBCL_H_~%#define _SBCL_H_~%")
(terpri)
+ ;; writing miscellaneous constants
(format t "#define SBCL_CORE_VERSION_INTEGER ~D~%" sbcl-core-version-integer)
(format t
"#define SBCL_VERSION_STRING ~S~%"
(sb!xc:lisp-implementation-version))
(format t "#define CORE_MAGIC 0x~X~%" core-magic)
(terpri)
-
;; FIXME: Other things from core.h should be defined here too:
;; #define CORE_END 3840
;; #define CORE_NDIRECTORY 3861
;; #define STATIC_SPACE_ID (2)
;; #define READ_ONLY_SPACE_ID (3)
+ ;; writing entire families of named constants from SB!VM
(let ((constants nil))
(do-external-symbols (symbol (find-package "SB!VM"))
(when (constantp symbol)
(test-tail "-SUBTYPE" "subtype_" 3)
(test-head "TRACE-TABLE-" "tracetab_" 4)
(test-tail "-SC-NUMBER" "sc_" 5)
- ;; This simpler style of munging of names seems less
+ ;; This simpler style of translation of names seems less
;; confusing, and is used for newer code.
(when (some (lambda (suffix) (tail-comp name suffix))
#("-START" "-END"))
(< (second const1) (second const2))))))
(let ((prev-priority (second (car constants))))
(dolist (const constants)
- (unless (= prev-priority (second const))
- (terpri)
- (setf prev-priority (second const)))
- (format t
- "#define ~A ~D /* 0x~X */~@[ /* ~A */~]~%"
- (first const)
- (third const)
- (third const)
- (fourth const))))
- (terpri)
- (format t "#define ERRORS { \\~%")
- ;; FIXME: Is this just DO-VECTOR?
- (let ((internal-errors sb!c:*backend-internal-errors*))
- (dotimes (i (length internal-errors))
- (format t " ~S, /*~D*/ \\~%" (cdr (aref internal-errors i)) i)))
- (format t " NULL \\~%}~%")
+ (destructuring-bind (name priority value doc) const
+ (unless (= prev-priority priority)
+ (terpri)
+ (setf prev-priority priority))
+ (format t "#define ~A " name)
+ (format t
+ ;; KLUDGE: As of sbcl-0.6.7.14, we're dumping two
+ ;; different kinds of values here, (1) small codes
+ ;; and (2) machine addresses. The small codes can be
+ ;; dumped as bare integer values. The large machine
+ ;; addresses might cause problems if they're large
+ ;; and represented as (signed) C integers, so we
+ ;; want to force them to be unsigned. We do that by
+ ;; wrapping them in the LISPOBJ macro. (We could do
+ ;; it with a bare "(unsigned)" cast, except that
+ ;; this header file is used not only in C files, but
+ ;; also in assembly files, which don't understand
+ ;; the cast syntax. The LISPOBJ macro goes away in
+ ;; assembly files, but that shouldn't matter because
+ ;; we don't do arithmetic on address constants in
+ ;; assembly files. See? It really is a kludge..) --
+ ;; WHN 2000-10-18
+ (let (;; cutoff for treatment as a small code
+ (cutoff (expt 2 16)))
+ (cond ((minusp value)
+ (error "stub: negative values unsupported"))
+ ((< value cutoff)
+ "~D")
+ (t
+ "LISPOBJ(~D)")))
+ value)
+ (format t " /* 0x~X */~@[ /* ~A */~]~%" value doc))))
(terpri))
+
+ ;; writing codes/strings for internal errors
+ (format t "#define ERRORS { \\~%")
+ ;; FIXME: Is this just DO-VECTOR?
+ (let ((internal-errors sb!c:*backend-internal-errors*))
+ (dotimes (i (length internal-errors))
+ (format t " ~S, /*~D*/ \\~%" (cdr (aref internal-errors i)) i)))
+ (format t " NULL \\~%}~%")
+ (terpri)
+
+ ;; writing primitive object layouts
(let ((structs (sort (copy-list sb!vm:*primitive-objects*) #'string<
:key #'(lambda (obj)
(symbol-name
(- (* (sb!vm:slot-offset slot) sb!vm:word-bytes) lowtag)))
(terpri))))
(format t "#endif /* LANGUAGE_ASSEMBLY */~2%"))
+
+ ;; writing static symbol offsets
(dolist (symbol (cons nil sb!vm:*static-symbols*))
;; FIXME: It would be nice to use longer names NIL and (particularly) T
;; in #define statements.
sb!vm:word-bytes
sb!vm:other-pointer-type
(if symbol (sb!vm:static-symbol-offset symbol) 0)))))
+
+ ;; Voila.
(format t "~%#endif~%"))
\f
;;;; writing map file
switch (id) {
case DYNAMIC_SPACE_ID:
if (addr != (os_vm_address_t)DYNAMIC_SPACE_START) {
- lose("incorrect dynamic space");
+ lose("core/runtime address mismatch: DYNAMIC_SPACE_START");
}
#if defined(ibmrt) || defined(__i386__)
SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer);
#endif
break;
case STATIC_SPACE_ID:
- static_space = (lispobj *) addr;
+ if (addr != (os_vm_address_t)STATIC_SPACE_START) {
+ lose("core/runtime address mismatch: STATIC_SPACE_START");
+ }
break;
case READ_ONLY_SPACE_ID:
- /* We don't care about read-only space. */
+ if (addr != (os_vm_address_t)READ_ONLY_SPACE_START) {
+ lose("core/runtime address mismatch: READ_ONLY_SPACE_START");
+ }
break;
default:
lose("unknown space ID %ld", id);
#include "runtime.h"
#include "sbcl.h"
#include "os.h"
+#include "interr.h"
#include "globals.h"
#include "interrupt.h"
#include "validate.h"
#include "lispregs.h"
+#include "arch.h"
#include "gc.h"
#include "gencgc.h"
for (j = 0; j < last_free_page; j++)
if (page_table[j].gen == i) {
+
/* Count the number of boxed pages within the given
- * generation */
- if (page_table[j].allocated == BOXED_PAGE)
+ * generation. */
+ if (page_table[j].allocated == BOXED_PAGE) {
if (page_table[j].large_object)
large_boxed_cnt++;
else
boxed_cnt++;
-
+ }
+
/* Count the number of unboxed pages within the given
- * generation */
- if (page_table[j].allocated == UNBOXED_PAGE)
+ * generation. */
+ if (page_table[j].allocated == UNBOXED_PAGE) {
if (page_table[j].large_object)
large_unboxed_cnt++;
else
unboxed_cnt++;
+ }
}
gc_assert(generations[i].bytes_allocated
#define DIRECT_SCAV 0
+/* FIXME: Most calls end up going to a little trouble to compute an
+ * 'nwords' value. The system might be a little simpler if this
+ * function used an 'end' parameter instead. */
static void
scavenge(lispobj *start, long nwords)
{
static lispobj *
search_static_space(lispobj *pointer)
{
- lispobj* start = (lispobj*)static_space;
+ lispobj* start = (lispobj*)STATIC_SPACE_START;
lispobj* end = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER);
if ((pointer < start) || (pointer >= end))
return NULL;
case type_FuncallableInstanceHeader:
case type_ByteCodeFunction:
case type_ByteCodeClosure:
- if ((int)pointer != ((int)start_addr+type_FunctionPointer)) {
+ if ((unsigned)pointer !=
+ ((unsigned)start_addr+type_FunctionPointer)) {
if (gencgc_verbose)
FSHOW((stderr,
"/Wf2: %x %x %x\n",
}
break;
case type_ListPointer:
- if ((int)pointer != ((int)start_addr+type_ListPointer)) {
+ if ((unsigned)pointer !=
+ ((unsigned)start_addr+type_ListPointer)) {
if (gencgc_verbose)
FSHOW((stderr,
"/Wl1: %x %x %x\n",
return 0;
}
case type_InstancePointer:
- if ((int)pointer != ((int)start_addr+type_InstancePointer)) {
+ if ((unsigned)pointer !=
+ ((unsigned)start_addr+type_InstancePointer)) {
if (gencgc_verbose)
FSHOW((stderr,
"/Wi1: %x %x %x\n",
}
break;
case type_OtherPointer:
- if ((int)pointer != ((int)start_addr+type_OtherPointer)) {
+ if ((unsigned)pointer !=
+ ((int)start_addr+type_OtherPointer)) {
if (gencgc_verbose)
FSHOW((stderr,
"/Wo1: %x %x %x\n",
region_allocation = page_table[addr_page_index].allocated;
- /* Check the offset within the page */
- if (((int)addr & 0xfff) > page_table[addr_page_index].bytes_used)
+ /* Check the offset within the page.
+ *
+ * FIXME: The mask should have a symbolic name, and ideally should
+ * be derived from page size instead of hardwired to 0xfff.
+ * (Also fix other uses of 0xfff, elsewhere.) */
+ if (((unsigned)addr & 0xfff) > page_table[addr_page_index].bytes_used)
return;
if (enable_pointer_filter && !valid_dynamic_space_pointer(addr))
if ((page_table[addr_page_index].allocated == FREE_PAGE)
|| (page_table[addr_page_index].bytes_used == 0)
/* Check the offset within the page. */
- || (((int)addr & 0xfff)
+ || (((unsigned)addr & 0xfff)
> page_table[addr_page_index].bytes_used)) {
FSHOW((stderr,
"weird? ignore ptr 0x%x to freed area of large object\n",
(unsigned)stack_pointer);
if ((stack_pointer > control_stack) &&
(stack_pointer < control_stack_end)) {
- unsigned int length = ((int)control_stack_end -
- (int)stack_pointer) / 4;
+ /* FIXME: Ick!
+ * (1) hardwired word length = 4; and as usual,
+ * when fixing this, check for other places
+ * with the same problem
+ * (2) calling it 'length' suggests bytes;
+ * perhaps 'size' instead? */
+ unsigned int length = ((unsigned)control_stack_end -
+ (unsigned)stack_pointer) / 4;
int j;
if (length >= vector_length) {
lose("invalid stack size %d >= vector length %d",
extern int undefined_tramp;
static void
-verify_space(lispobj*start, size_t words)
+verify_space(lispobj *start, size_t words)
{
- int dynamic_space = (find_page_index((void*)start) != -1);
- int readonly_space =
- (READ_ONLY_SPACE_START <= (int)start &&
- (int)start < SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
+ int is_in_dynamic_space = (find_page_index((void*)start) != -1);
+ int is_in_readonly_space =
+ (READ_ONLY_SPACE_START <= (unsigned)start &&
+ (unsigned)start < SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
while (words > 0) {
size_t count = 1;
(READ_ONLY_SPACE_START <= thing &&
thing < SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
int to_static_space =
- ((int)static_space <= thing &&
+ (STATIC_SPACE_START <= thing &&
thing < SymbolValue(STATIC_SPACE_FREE_POINTER));
/* Does it point to the dynamic space? */
}
/* Check that its not in the RO space as it would then be a
* pointer from the RO to the dynamic space. */
- if (readonly_space) {
+ if (is_in_readonly_space) {
lose("ptr to dynamic space %x from RO space %x",
thing, start);
}
} else {
/* Verify that it points to another valid space. */
if (!to_readonly_space && !to_static_space
- && (thing != (int)&undefined_tramp)) {
+ && (thing != (unsigned)&undefined_tramp)) {
lose("Ptr %x @ %x sees junk.", thing, start);
}
}
/* Check that it's not in the dynamic space.
* FIXME: Isn't is supposed to be OK for code
* objects to be in the dynamic space these days? */
- if (dynamic_space
+ if (is_in_dynamic_space
/* It's ok if it's byte compiled code. The trace
* table offset will be a fixnum if it's x86
* compiled code - check. */
static void
verify_gc(void)
{
+ /* FIXME: It would be nice to make names consistent so that
+ * foo_size meant size *in* *bytes* instead of size in some
+ * arbitrary units. (Yes, this caused a bug, how did you guess?:-)
+ * Some counts of lispobjs are called foo_count; it might be good
+ * to grep for all foo_size and rename the appropriate ones to
+ * foo_count. */
int read_only_space_size =
(lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER)
- (lispobj*)READ_ONLY_SPACE_START;
int static_space_size =
(lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER)
- - (lispobj*)static_space;
+ - (lispobj*)STATIC_SPACE_START;
int binding_stack_size =
(lispobj*)SymbolValue(BINDING_STACK_POINTER)
- (lispobj*)BINDING_STACK_START;
verify_space((lispobj*)READ_ONLY_SPACE_START, read_only_space_size);
- verify_space((lispobj*)static_space, static_space_size);
- verify_space((lispobj*)BINDING_STACK_START, binding_stack_size);
+ verify_space((lispobj*)STATIC_SPACE_START , static_space_size);
+ verify_space((lispobj*)BINDING_STACK_START , binding_stack_size);
}
static void
} else {
int free_bytes = 4096 - page_table[page].bytes_used;
if (free_bytes > 0) {
- int *start_addr = (int *)((int)page_address(page)
+ int *start_addr = (int *)((unsigned)page_address(page)
+ page_table[page].bytes_used);
int size = free_bytes / 4;
int i;
}
/* Scavenge the binding stack. */
- scavenge(binding_stack,
- (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack);
+ scavenge(BINDING_STACK_START,
+ (lispobj *)SymbolValue(BINDING_STACK_POINTER) -
+ (lispobj *)BINDING_STACK_START);
if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) {
read_only_space_size =
- (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER)
- - read_only_space;
+ (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER) -
+ (lispobj*)READ_ONLY_SPACE_START;
FSHOW((stderr,
"/scavenge read only space: %d bytes\n",
read_only_space_size * sizeof(lispobj)));
- scavenge(read_only_space, read_only_space_size);
+ scavenge(READ_ONLY_SPACE_START, read_only_space_size);
}
- static_space_size = (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER)
- - static_space;
+ static_space_size =
+ (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER) -
+ (lispobj *)STATIC_SPACE_START;
if (gencgc_verbose > 1)
FSHOW((stderr,
"/scavenge static space: %d bytes\n",
static_space_size * sizeof(lispobj)));
- scavenge(static_space, static_space_size);
+ scavenge(STATIC_SPACE_START, static_space_size);
/* All generations but the generation being GCed need to be
* scavenged. The new_space generation needs special handling as
lispobj *current_binding_stack_pointer;
#endif
-lispobj *read_only_space;
-lispobj *static_space;
lispobj *control_stack;
#ifdef __i386__
lispobj *control_stack_end;
#endif
-lispobj *binding_stack;
#ifndef ALLOCATION_POINTER
lispobj *dynamic_space_free_pointer;
current_control_frame_pointer = (lispobj *)0;
#ifndef BINDING_STACK_POINTER
- current_binding_stack_pointer = binding_stack;
+ current_binding_stack_pointer = BINDING_STACK_START;
#endif
}
extern lispobj *current_binding_stack_pointer;
#endif
-extern lispobj *read_only_space;
-extern lispobj *static_space;
extern lispobj *control_stack;
-extern lispobj *binding_stack;
#ifdef __i386__
extern lispobj *control_stack_end;
#endif
lispobj *headerptr;
/* Search static space. */
- headerptr = static_space;
- count = ((lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER) -
- static_space);
+ headerptr = (lispobj *)STATIC_SPACE_START;
+ count =
+ (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER) -
+ (lispobj *)STATIC_SPACE_START;
if (search_for_symbol(name, &headerptr, &count)) {
*result = (lispobj)headerptr | type_OtherPointer;
return 1;
}
/* Search dynamic space. */
- headerptr = DYNAMIC_SPACE_START;
+ headerptr = (lispobj *)DYNAMIC_SPACE_START;
#if !defined(ibmrt) && !defined(__i386__)
- count = dynamic_space_free_pointer - DYNAMIC_SPACE_START;
+ count =
+ dynamic_space_free_pointer -
+ (lispobj *)DYNAMIC_SPACE_START;
#else
- count = (lispobj *)SymbolValue(ALLOCATION_POINTER) - DYNAMIC_SPACE_START;
+ count =
+ (lispobj *)SymbolValue(ALLOCATION_POINTER) -
+ (lispobj *)DYNAMIC_SPACE_START;
#endif
if (search_for_symbol(name, &headerptr, &count)) {
*result = (lispobj)headerptr | type_OtherPointer;
fflush(stdout);
#endif
#if !defined(ibmrt) && !defined(__i386__)
- pscav(binding_stack, current_binding_stack_pointer - binding_stack, 0);
+ pscav(BINDING_STACK_START,
+ current_binding_stack_pointer - (lispobj *)BINDING_STACK_START,
+ 0);
#else
- pscav(binding_stack, (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack, 0);
+ pscav(BINDING_STACK_START,
+ (lispobj *)SymbolValue(BINDING_STACK_POINTER) -
+ (lispobj *)BINDING_STACK_START,
+ 0);
#endif
#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) - read_only_space;
+ (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(read_only_space, read_only_space_size, 0);
+ pscav(READ_ONLY_SPACE_START, read_only_space_size, 0);
}
#endif
printf(" static");
fflush(stdout);
#endif
- clean = static_space;
+ clean = (lispobj *)STATIC_SPACE_START;
do {
while (clean != static_free)
clean = pscav(clean, static_free - clean, 0);
#include "interrupt.h"
#include "arch.h"
#include "gc.h"
+#include "interr.h"
#include "monitor.h"
#include "validate.h"
#if defined GENCGC
#endif
#ifdef BINDING_STACK_POINTER
- SetSymbolValue(BINDING_STACK_POINTER, (lispobj)binding_stack);
+ SetSymbolValue(BINDING_STACK_POINTER, BINDING_STACK_START);
#endif
#if defined INTERNAL_GC_TRIGGER && !defined __i386__
SetSymbolValue(INTERNAL_GC_TRIGGER, make_fixnum(-1));
#include "core.h"
#include "globals.h"
#include "save.h"
+#include "dynbind.h"
#include "lispregs.h"
#include "validate.h"
bytes = words * sizeof(lispobj);
- printf("writing %d bytes from the %s space at 0x%08X\n",
+ 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);
putw(CORE_NDIRECTORY, file);
putw((5*3)+2, file);
- output_space(file, READ_ONLY_SPACE_ID, read_only_space,
+ output_space(file, READ_ONLY_SPACE_ID, (lispobj *)READ_ONLY_SPACE_START,
(lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
- output_space(file, STATIC_SPACE_ID, static_space,
+ output_space(file, STATIC_SPACE_ID, (lispobj *)STATIC_SPACE_START,
(lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER));
#ifdef reg_ALLOC
- output_space(file, DYNAMIC_SPACE_ID, DYNAMIC_SPACE_START,
+ output_space(file, DYNAMIC_SPACE_ID, (lispobj *)DYNAMIC_SPACE_START,
dynamic_space_free_pointer);
#else
#ifdef GENCGC
fflush(stdout);
#endif
- /* Read-Only Space */
- read_only_space = (lispobj *) READ_ONLY_SPACE_START;
- ensure_space(read_only_space, READ_ONLY_SPACE_SIZE);
+ ensure_space(READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE);
- /* Static Space */
- static_space = (lispobj *) STATIC_SPACE_START;
- ensure_space(static_space, STATIC_SPACE_SIZE);
+ ensure_space(STATIC_SPACE_START, STATIC_SPACE_SIZE);
- /* Dynamic-0 Space */
ensure_space(DYNAMIC_SPACE_START, DYNAMIC_SPACE_SIZE);
- /* Control Stack */
control_stack = (lispobj *) CONTROL_STACK_START;
#ifdef __i386__
control_stack_end = (lispobj *) (CONTROL_STACK_START
#endif
ensure_space(control_stack, CONTROL_STACK_SIZE);
- /* Binding Stack */
- binding_stack = (lispobj *) BINDING_STACK_START;
- ensure_space(binding_stack, BINDING_STACK_SIZE);
+ ensure_space(BINDING_STACK_START, BINDING_STACK_SIZE);
#ifdef HOLES
make_holes();
;;; versions, and a string a la "0.6.5.12" is used for versions which
;;; aren't released but correspond only to CVS tags or snapshots.
-"0.6.7.13"
+"0.6.7.14"
projects / sbcl.git / commitdiff