common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

0.6.7.15: control_stack stuff redone as Lisp/C constants

Browse source
This commit is contained in:
William Harold Newman 2000-10-18 23:08:20 +00:00
parent d0583fb59b
commit 5f338d3142
16 changed files with 70 additions and 154 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
package-data-list.lisp-expr
View file

@ -1689,7 +1689,7 @@ structure representations"
"SYMBOL-RAW-FUNCTION-ADDR-SLOT" "SYMBOL-SETF-FUNCTION-SLOT"
"SYMBOL-SIZE" "SYMBOL-UNUSED-SLOT" "SYMBOL-VALUE-SLOT"
"BINDING-STACK-START" "TARGET-BYTE-ORDER"
"CONTROL-STACK-START" "DYNAMIC-SPACE-START"
"CONTROL-STACK-START" "CONTROL-STACK-END" "DYNAMIC-SPACE-START"
"TARGET-FASL-CODE-FORMAT" "TARGET-FASL-FILE-TYPE"
"TARGET-HEAP-ADDRESS-SPACE" "*TARGET-MOST-NEGATIVE-FIXNUM*"
"*TARGET-MOST-POSITIVE-FIXNUM*" "READ-ONLY-SPACE-START"

15
src/code/debug-int.lisp
View file

@ -674,18 +674,15 @@
#!-sb-fluid (declaim (inline cstack-pointer-valid-p))
(defun cstack-pointer-valid-p (x)
(declare (type system-area-pointer x))
#!-x86
#!-x86 ; stack grows toward high address values
(and (sap< x (current-sp))
(sap<= #!-gengc (sb!alien:alien-sap
(sb!alien:extern-alien "control_stack" (* t)))
(sap<= #!-gengc (int-sap control-stack-start)
#!+gengc (mutator-control-stack-base)
x)
(zerop (logand (sap-int x) #b11)))
#!+x86 ;; stack grows to low address values
#!+x86 ; stack grows toward low address values
(and (sap>= x (current-sp))
(sap> (sb!alien:alien-sap (sb!alien:extern-alien "control_stack_end"
(* t)))
x)
(sap> (int-sap control-stack-end) x)
(zerop (logand (sap-int x) #b11))))
#!+(or gengc x86)
@ -729,9 +726,7 @@
;; Not the first page which is unmapped.
(>= (sap-int ra) 4096)
;; Not a Lisp stack pointer.
(or (sap< ra (current-sp))
(sap>= ra (sb!alien:alien-sap
(sb!alien:extern-alien "control_stack_end" (* t)))))))
(not (cstack-pointer-valid-p ra))))
;;; Try to find a valid previous stack. This is complex on the x86 as
;;; it can jump between C and Lisp frames. To help find a valid frame

7
src/code/gc.lisp
View file

@ -26,9 +26,6 @@
(defun ,lisp-fun ()
(sb!alien:extern-alien ,c-var-name (sb!alien:unsigned 32))))))
(def-c-var-frob sb!vm:control-stack-start "control_stack")
#!+x86 (def-c-var-frob control-stack-end "control_stack_end")
#!-sb-fluid (declaim (inline dynamic-usage))
(def-c-var-frob dynamic-usage "bytes_allocated")
@ -42,8 +39,8 @@
(defun control-stack-usage ()
#!-x86 (- (sb!sys:sap-int (sb!c::control-stack-pointer-sap))
(control-stack-start))
#!+x86 (- (control-stack-end)
control-stack-start)
#!+x86 (- control-stack-end
(sb!sys:sap-int (sb!c::control-stack-pointer-sap))))
(defun binding-stack-usage ()

41
src/compiler/generic/objdef.lisp
View file

@ -245,43 +245,6 @@
;;; (For an explanation of this, see the comments at the definition of
;;; KLUDGE-NONDETERMINISTIC-CATCH-BLOCK-SIZE.)
(assert (= sb!vm::kludge-nondeterministic-catch-block-size catch-block-size))
#!+gengc
(define-primitive-object (mutator)
;; Holds the lisp thread structure, if any.
(thread)
;; Signal control magic.
(foreign-fn-call-active :c-type "boolean")
(interrupts-disabled-count :c-type "int")
(interrupt-pending :c-type "boolean")
(pending-signal :c-type "int")
(pending-code :c-type "int")
(pending-mask :c-type "int")
(gc-pending :c-type "boolean")
;; Stacks.
(control-stack-base :c-type "lispobj *")
(control-stack-pointer :c-type "lispobj *")
(control-stack-end :c-type "lispobj *")
(control-frame-pointer :c-type "lispobj *")
(current-unwind-protect :c-type "struct unwind_block *")
(current-catch-block :c-type "struct catch_block *")
(binding-stack-base :c-type "struct binding *")
(binding-stack-pointer :c-type "struct binding *")
(binding-stack-end :c-type "struct binding *")
(number-stack-base :c-type "char *")
(number-stack-pointer :c-type "char *")
(number-stack-end :c-type "char *")
(eval-stack)
(eval-stack-top)
;; Allocation stuff.
(nursery-start :c-type "lispobj *")
(nursery-fill-pointer :c-type "lispobj *")
(nursery-end :c-type "lispobj *")
(storebuf-start :c-type "lispobj **")
(storebuf-fill-pointer :c-type "lispobj **")
(storebuf-end :c-type "lispobj **")
(words-consed :c-type "unsigned long"))
;;;; symbols
@ -289,11 +252,11 @@
(defknown %make-symbol (index simple-string) symbol
(flushable movable))
#+gengc
#!+gengc
(defknown symbol-hash (symbol) index
(flushable movable))
#+x86
#!+x86
(defknown symbol-hash (symbol) (integer 0 #.*target-most-positive-fixnum*)
(flushable movable))

30
src/compiler/x86/parms.lisp
View file

@ -123,25 +123,45 @@
;;; duplicated between this file and runtime/x86-validate.h.
;;;
;;; Note: Mostly these values are black magic, inherited from CMU CL
;;; without any documentation. However, there have been a few changes
;;; since the fork:
;;; * The FreeBSD STATIC-SPACE-START value was bumped up
;;; from #x28000000 to #x30000000 when FreeBSD ld.so dynamic linking
;;; without any documentation. However, there were a few explanatory
;;; comments in the CMU CL sources:
;;; * On Linux,
;;; ** The space 0x08000000-0x10000000 is "C program and memory allocation".
;;; ** The space 0x40000000-0x48000000 is reserved for shared libs.
;;; ** The space >0xE0000000 is "C stack - Alien stack".
;;; * On FreeBSD,
;;; ** The space 0x0E000000-0x10000000 is "Foreign segment".
;;; ** The space 0x20000000-0x30000000 is reserved for shared libs.
;;; And there have been a few changes since the fork:
;;; * The FreeBSD STATIC-SPACE-START value was bumped up from
;;; #x28000000 to #x30000000 when FreeBSD ld.so dynamic linking
;;; support was added for FreeBSD ca. 20000910. This was to keep from
;;; stomping on an address range that the dynamic libraries want to use.
;;; (They want to use this address range even if we try to reserve it
;;; with a call to validate() as the first operation in main().)
#!+linux
(progn
(defconstant read-only-space-start #x01000000)
(defconstant static-space-start #x05000000)
(defconstant dynamic-space-start #x09000000))
(defconstant dynamic-space-start #x09000000)
(defconstant control-stack-start #x50000000)
(defconstant control-stack-end #x57fff000))
#!+bsd
(progn
(defconstant read-only-space-start #x10000000)
(defconstant static-space-start
#!+freebsd #x30000000
#!+openbsd #x28000000)
(defconstant control-stack-start #x40000000)
(defconstant control-stack-end #x07fff000)
(defconstant dynamic-space-start #x48000000))
;;; Given that NIL is the first thing allocated in static space, we

2
src/compiler/x86/type-vops.lisp
View file

@ -109,7 +109,7 @@
;;; Emit the most compact form of the test immediate instruction,
;;; using an 8 bit test when the immediate is only 8 bits and the
;;; value is one of the four low registers (eax, ebx, ecx, edx) or the
;;; control-stack.
;;; control stack.
(defun generate-fixnum-test (value)
(let ((offset (tn-offset value)))
(cond ((and (sc-is value any-reg descriptor-reg)

5
src/runtime/backtrace.c
View file

@ -94,8 +94,9 @@ code_pointer(lispobj object)
static boolean
cs_valid_pointer_p(struct call_frame *pointer)
{
return (((char *) control_stack <= (char *) pointer) &&
((char *) pointer < (char *) current_control_stack_pointer));
lose("stub: hasn't been updated for X86");
return (((char *) CONTROL_STACK_START <= (char *) pointer) &&
((char *) pointer < (char *) current_control_stack_pointer));
}
static void

16
src/runtime/gencgc.c
View file

@ -4604,19 +4604,19 @@ scavenge_thread_stacks(void)
vector_length));
if (vector_length > 0) {
lispobj *stack_pointer = (lispobj*)stack->data[0];
if ((stack_pointer < control_stack) ||
(stack_pointer > control_stack_end))
if ((stack_pointer < (lispobj *)CONTROL_STACK_START) ||
(stack_pointer > (lispobj *)CONTROL_STACK_END))
lose("invalid stack pointer %x",
(unsigned)stack_pointer);
if ((stack_pointer > control_stack) &&
(stack_pointer < control_stack_end)) {
if ((stack_pointer > (lispobj *)CONTROL_STACK_START) &&
(stack_pointer < (lispobj *)CONTROL_STACK_END)) {
/* 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 int length = ((unsigned)CONTROL_STACK_END -
(unsigned)stack_pointer) / 4;
int j;
if (length >= vector_length) {
@ -5663,9 +5663,11 @@ garbage_collect_generation(int generation, int raise)
/* Scavenge the stack's conservative roots. */
{
lispobj **ptr;
for (ptr = (lispobj **)CONTROL_STACK_END-1;
ptr > (lispobj **)&raise; ptr--)
for (ptr = (lispobj **)CONTROL_STACK_END - 1;
ptr > (lispobj **)&raise;
ptr--) {
preserve_pointer(*ptr);
}
}
#ifdef CONTROL_STACKS
scavenge_thread_stacks();

9
src/runtime/globals.c
View file

@ -31,11 +31,6 @@ lispobj *current_control_frame_pointer;
lispobj *current_binding_stack_pointer;
#endif
lispobj *control_stack;
#ifdef __i386__
lispobj *control_stack_end;
#endif
#ifndef ALLOCATION_POINTER
lispobj *dynamic_space_free_pointer;
#endif
@ -58,9 +53,9 @@ void globals_init(void)
/* Initialize the current Lisp state. */
#ifndef __i386__
current_control_stack_pointer = control_stack;
current_control_stack_pointer = (lispobj *)CONTROL_STACK_START;
#else
current_control_stack_pointer = control_stack_end;
current_control_stack_pointer = (lispobj *)CONTROL_STACK_END;
#endif
current_control_frame_pointer = (lispobj *)0;

4
src/runtime/globals.h
View file

@ -28,10 +28,6 @@ extern lispobj *current_control_frame_pointer;
extern lispobj *current_binding_stack_pointer;
#endif
extern lispobj *control_stack;
#ifdef __i386__
extern lispobj *control_stack_end;
#endif
#if !defined(ibmrt) && !defined(__i386__)
extern lispobj *dynamic_space_free_pointer;
extern lispobj *current_auto_gc_trigger;

3
src/runtime/linux-os.c
View file

@ -236,6 +236,9 @@ os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot)
}
}
/* FIXME: Now that FOO_END, rather than FOO_SIZE, is the fundamental
* description of a space, we could probably punt this and just do
* (FOO_START <= x && x < FOO_END) everywhere it's called. */
static boolean
in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen)
{

16
src/runtime/purify.c
View file

@ -1401,8 +1401,8 @@ int purify(lispobj static_roots, lispobj read_only_roots)
#endif
#ifdef GENCGC
gc_assert(control_stack_end > ((&read_only_roots)+1));
setup_i386_stack_scav(((&static_roots)-2), control_stack_end);
gc_assert((lispobj *)CONTROL_STACK_END > ((&read_only_roots)+1));
setup_i386_stack_scav(((&static_roots)-2), (lispobj *)CONTROL_STACK_END);
#endif
pscav(&static_roots, 1, 0);
@ -1421,14 +1421,17 @@ int purify(lispobj static_roots, lispobj read_only_roots)
fflush(stdout);
#endif
#ifndef __i386__
pscav(control_stack, current_control_stack_pointer - control_stack, 0);
pscav((lispobj *)control_stack,
current_control_stack_pointer - (lispobj *)CONTROL_STACK_START,
0);
#else
#ifdef GENCGC
pscav_i386_stack();
#endif
#ifdef WANT_CGC
gc_assert(control_stack_end > ((&read_only_roots)+1));
carefully_pscav_stack(((&read_only_roots)+1), control_stack_end);
gc_assert((lispobj *)control_stack_end > ((&read_only_roots)+1));
carefully_pscav_stack(((&read_only_roots)+1),
(lispobj *)CONTROL_STACK_END);
#endif
#endif
@ -1510,7 +1513,8 @@ int purify(lispobj static_roots, lispobj read_only_roots)
#ifndef __i386__
os_zero((os_vm_address_t) current_control_stack_pointer,
(os_vm_size_t) (CONTROL_STACK_SIZE -
((current_control_stack_pointer - control_stack) *
((current_control_stack_pointer -
(lispobj *)CONTROL_STACK_START) *
sizeof(lispobj))));
#endif

17
src/runtime/validate.c
View file

@ -64,19 +64,10 @@ void validate(void)
#endif
ensure_space(READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE);
ensure_space(STATIC_SPACE_START, STATIC_SPACE_SIZE);
ensure_space(DYNAMIC_SPACE_START, DYNAMIC_SPACE_SIZE);
control_stack = (lispobj *) CONTROL_STACK_START;
#ifdef __i386__
control_stack_end = (lispobj *) (CONTROL_STACK_START
+ CONTROL_STACK_SIZE);
#endif
ensure_space(control_stack, CONTROL_STACK_SIZE);
ensure_space(BINDING_STACK_START, BINDING_STACK_SIZE);
ensure_space(STATIC_SPACE_START , STATIC_SPACE_SIZE);
ensure_space(DYNAMIC_SPACE_START , DYNAMIC_SPACE_SIZE);
ensure_space(CONTROL_STACK_START , CONTROL_STACK_SIZE);
ensure_space(BINDING_STACK_START , BINDING_STACK_SIZE);
#ifdef HOLES
make_holes();

2
src/runtime/x86-arch.c
View file

@ -219,7 +219,7 @@ sigtrap_handler(int signal, siginfo_t *info, void *void_context)
/* This is just for info in case the monitor wants to print an
* approximation. */
current_control_stack_pointer =
(lispobj*)*os_context_sp_addr(context);
(lispobj *)*os_context_sp_addr(context);
/* On entry %eip points just after the INT3 byte and aims at the
* 'kind' value (eg trap_Cerror). For error-trap and Cerror-trap a

53
src/runtime/x86-validate.h
View file

@ -13,39 +13,6 @@
* $Header$
*/
/*
* address map:
*
* FreeBSD:
* 0x00000000->0x0E000000 224M C program and memory allocation.
* 0x0E000000->0x10000000 32M Foreign segment.
* 0x10000000->0x20000000 256M Read-Only Space.
* 0x20000000->0x30000000 256M Reserved for shared libraries.
* 0x30000000->0x38000000 128M Static Space.
* 0x38000000->0x40000000 128M Binding stack growing up.
* 0x40000000->0x48000000 128M Control stack growing down.
* 0x48000000->0xC8000000 2GB Dynamic Space.
* 0xE0000000-> 256M C stack - Alien stack.
*
* OpenBSD:
* almost the same as FreeBSD
*
* Linux: Note that this map has some problems and requires some further
* development so is not implemented below.
* 0x00000000->0x08000000 128M Unused.
* 0x08000000->0x10000000 128M C program and memory allocation.
* 0x10000000->0x20000000 256M Read-Only Space.
* 0x20000000->0x28000000 128M Binding stack growing up.
* 0x28000000->0x38000000 256M Static Space.
* 0x38000000->0x40000000 128M Control stack growing down.
* 0x40000000->0x48000000 128M Reserved for shared libraries.
* 0x48000000->0xB8000000 1.75G Dynamic Space.
*
* FIXME: There's something wrong with addressing maps which are so
* brittle that they can be commented as fixed addresses. Try to
* parameterize these so they can be set at build time.
*/
#if defined(__FreeBSD__) || defined(__OpenBSD__)
#define READ_ONLY_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */
@ -57,27 +24,12 @@
#error unsupported BSD variant
#endif
#define BINDING_STACK_START (0x38000000)
#define BINDING_STACK_SIZE (0x07fff000) /* 128MB - 1 page */
#define CONTROL_STACK_START (0x40000000)
#define CONTROL_STACK_SIZE (0x08000000) /* 128MB */
#define DYNAMIC_SPACE_SIZE (0x40000000) /* may be up to 2GB */
#endif
/* FIXME: It's gross to have numbers like 0x50000000 wired into the
* code in multiple places like this. (Not only does this file know
* about it, but Lisp code knows about it, because Lisp code is able
* to generate absolute addresses for all the static symbols even
* before it's read the map file.) I don't know whether I should
* actually *fix* this, but I should at least document it some with a
* KLUDGE marker. And it might even be fixable, by putting all this
* memory space arbitrariness into an architecture-dependent Lisp
* file. If so, perhaps I should write somewhere in a "design
* principles" or "coding principles" file that information like this
* always flows from Lisp code to C code, through sbcl.h. */
#ifdef __linux__
#define READ_ONLY_SPACE_SIZE (0x02800000) /* 40MB */
@ -86,10 +38,7 @@
#define BINDING_STACK_START (0x60000000)
#define BINDING_STACK_SIZE (0x07fff000) /* 128MB - 1 page */
#define CONTROL_STACK_START (0x50000000)
#define CONTROL_STACK_SIZE (0x07fff000) /* 128MB - 1 page */
#define DYNAMIC_SPACE_SIZE (0x20000000) /* 512MB */
#endif
#define CONTROL_STACK_END (CONTROL_STACK_START + CONTROL_STACK_SIZE)
#define CONTROL_STACK_SIZE (CONTROL_STACK_END - CONTROL_STACK_START)

2
version.lisp-expr
View file

@ -15,4 +15,4 @@
;;; 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.14"
"0.6.7.15"