From: William Harold Newman Date: Sat, 16 Mar 2002 14:29:48 +0000 (+0000) Subject: 0.7.1.40: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=fc6400512d98021430dcd7d95c4e5535c6fe9b86;p=sbcl.git 0.7.1.40: more-explicit names for new stack stuff (thanks to Dan Barlow sbcl-devel a week or so ago for pointing out unnoticed ambiguity)... ...mostly s/stack-exhaustion/control-stack-exhaustion/ related name clarification in old code... ...s/cstack/control-stack/ (since evidently the C stack is, on non-X86en, distinct from the Lisp control stack) --- diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index c0398b6..e98b3f7 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -952,8 +952,8 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "*CURRENT-LEVEL-IN-PRINT*" "*EMPTY-TYPE*" "*GC-INHIBIT*" "*NEED-TO-COLLECT-GARBAGE*" - "*PRETTY-PRINTER*" "*STACK-EXHAUSTION-SAP*" "*UNIVERSAL-TYPE*" - "*UNIVERSAL-FUN-TYPE*" + "*PRETTY-PRINTER*" "*CONTROL-STACK-EXHAUSTION-SAP*" + "*UNIVERSAL-TYPE*" "*UNIVERSAL-FUN-TYPE*" "*UNPARSE-FUN-TYPE-SIMPLIFY*" "*WILD-TYPE*" "32BIT-LOGICAL-AND" "32BIT-LOGICAL-ANDC1" "32BIT-LOGICAL-ANDC2" diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 14d1cbc..2137c0a 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -524,8 +524,8 @@ (defun get-lisp-obj-address (thing) (get-lisp-obj-address thing)) (defun fun-word-offset (fun) (fun-word-offset fun)) -#!-sb-fluid (declaim (inline cstack-pointer-valid-p)) -(defun cstack-pointer-valid-p (x) +#!-sb-fluid (declaim (inline control-stack-pointer-valid-p)) +(defun control-stack-pointer-valid-p (x) (declare (type system-area-pointer x)) #!+stack-grows-upward (and (sap< x (current-sp)) @@ -575,10 +575,13 @@ (defun ra-pointer-valid-p (ra) (declare (type system-area-pointer ra)) (and - ;; Not the first page which is unmapped. + ;; not the first page (which is unmapped) + ;; + ;; FIXME: Where is this documented? Is it really true of every CPU + ;; architecture? Is it even necessarily true in current SBCL? (>= (sap-int ra) 4096) - ;; Not a Lisp stack pointer. - (not (cstack-pointer-valid-p ra)))) + ;; not a Lisp stack pointer + (not (control-stack-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 @@ -594,7 +597,7 @@ (fixnum depth)) ;;(format t "*CC ~S ~S~%" fp depth) (cond - ((not (cstack-pointer-valid-p fp)) + ((not (control-stack-pointer-valid-p fp)) #+nil (format t "debug invalid fp ~S~%" fp) nil) (t @@ -604,9 +607,9 @@ 4)))) (c-ocfp (sap-ref-sap fp (* 0 sb!vm:n-word-bytes))) (c-ra (sap-ref-sap fp (* 1 sb!vm:n-word-bytes)))) - (cond ((and (sap> lisp-ocfp fp) (cstack-pointer-valid-p lisp-ocfp) + (cond ((and (sap> lisp-ocfp fp) (control-stack-pointer-valid-p lisp-ocfp) (ra-pointer-valid-p lisp-ra) - (sap> c-ocfp fp) (cstack-pointer-valid-p c-ocfp) + (sap> c-ocfp fp) (control-stack-pointer-valid-p c-ocfp) (ra-pointer-valid-p c-ra)) #+nil (format t "*C Both valid ~S ~S ~S ~S~%" @@ -640,12 +643,12 @@ #+nil (format t "debug: no valid2 fp found ~S ~S~%" lisp-ocfp c-ocfp) nil)))) - ((and (sap> lisp-ocfp fp) (cstack-pointer-valid-p lisp-ocfp) + ((and (sap> lisp-ocfp fp) (control-stack-pointer-valid-p lisp-ocfp) (ra-pointer-valid-p lisp-ra)) ;; The lisp convention is looking good. #+nil (format t "*C lisp-ocfp ~S ~S~%" lisp-ocfp lisp-ra) (values lisp-ra lisp-ocfp)) - ((and (sap> c-ocfp fp) (cstack-pointer-valid-p c-ocfp) + ((and (sap> c-ocfp fp) (control-stack-pointer-valid-p c-ocfp) #!-linux (ra-pointer-valid-p c-ra)) ;; The C convention is looking good. #+nil (format t "*C c-ocfp ~S ~S~%" c-ocfp c-ra) @@ -705,7 +708,7 @@ frame))) (bogus-debug-fun (let ((fp (frame-pointer frame))) - (when (cstack-pointer-valid-p fp) + (when (control-stack-pointer-valid-p fp) #!+x86 (multiple-value-bind (ra ofp) (x86-call-context fp) (compute-calling-frame ofp ra frame)) @@ -791,7 +794,7 @@ #!-x86 (defun compute-calling-frame (caller lra up-frame) (declare (type system-area-pointer caller)) - (when (cstack-pointer-valid-p caller) + (when (control-stack-pointer-valid-p caller) (multiple-value-bind (code pc-offset escaped) (if lra (multiple-value-bind (word-offset code) @@ -835,7 +838,7 @@ (defun compute-calling-frame (caller ra up-frame) (declare (type system-area-pointer caller ra)) (/noshow0 "entering COMPUTE-CALLING-FRAME") - (when (cstack-pointer-valid-p caller) + (when (control-stack-pointer-valid-p caller) (/noshow0 "in WHEN") ;; First check for an escaped frame. (multiple-value-bind (code pc-offset escaped) (find-escaped-frame caller) diff --git a/src/code/exhaust.lisp b/src/code/exhaust.lisp index 218843a..88f1954 100644 --- a/src/code/exhaust.lisp +++ b/src/code/exhaust.lisp @@ -12,23 +12,24 @@ (in-package "SB!KERNEL") -;;; a soft limit on stack overflow; the boundary beyond which the -;;; control stack will be considered to've overflowed +;;; a soft limit on control stack overflow; the boundary beyond which +;;; the control stack will be considered to've overflowed ;;; -;;; When stack overflow is detected, this soft limit is to be bound to -;;; a new value closer to the hard limit (allowing some more space for -;;; error handling) around the call to ERROR. +;;; When overflow is detected, this soft limit is to be bound to a new +;;; value closer to the hard limit (allowing some more space for error +;;; handling) around the call to ERROR, to allow space for the +;;; error-handling logic. ;;; ;;; FIXME: Maybe (probably?) this should be in SB!VM. And maybe the ;;; size of the buffer zone should be set in src/compiler/cpu/parms.lisp ;;; instead of constantly 1Mb for all CPU architectures? -(defvar *stack-exhaustion-sap* +(defvar *control-stack-exhaustion-sap* ;; (initialized in cold init) ) (defun !exhaust-cold-init () (let (;; initial difference between soft limit and hard limit (initial-slack (expt 2 20))) - (setf *stack-exhaustion-sap* + (setf *control-stack-exhaustion-sap* (int-sap #!+stack-grows-downward (+ sb!vm:control-stack-start initial-slack) #!+stack-grows-upward (- sb!vm:control-stack-end @@ -42,22 +43,26 @@ (when (#!+stack-grows-upward sap>= #!+stack-grows-downward sap<= (current-sp) - *stack-exhaustion-sap*) - (let ((*stack-exhaustion-sap* (revised-stack-exhaustion-sap))) + *control-stack-exhaustion-sap*) + (let ((*control-stack-exhaustion-sap* + (revised-control-stack-exhaustion-sap))) (warn "~@") - (error "The system control stack was exhausted.")))) + (error "The system control stack was exhausted."))) + ;; FIXME: It'd be good to check other stacks (e.g. binding stack) + ;; here too. + ) -;;; Return a revised value for the *STACK-EXHAUSTION-SAP* soft limit, -;;; allocating half the remaining space up to the hard limit in order -;;; to allow interactive debugging to be used around the point of a -;;; stack overflow failure without immediately failing again from the -;;; (continuing) stack overflow. -(defun revised-stack-exhaustion-sap () +;;; Return a revised value for the *CONTROL-STACK-EXHAUSTION-SAP* soft +;;; limit, allocating half the remaining space up to the hard limit in +;;; order to allow interactive debugging to be used around the point +;;; of a stack overflow failure without immediately failing again from +;;; the (continuing) stack overflow. +(defun revised-control-stack-exhaustion-sap () (let* ((old-slack #!+stack-grows-upward (- sb!vm:control-stack-end - (sap-int *stack-exhaustion-sap*)) - #!+stack-grows-downward (- (sap-int *stack-exhaustion-sap*) + (sap-int *control-stack-exhaustion-sap*)) + #!+stack-grows-downward (- (sap-int *control-stack-exhaustion-sap*) sb!vm:control-stack-start)) (new-slack (ash old-slack -1))) (int-sap diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp index acf1993..4f3b7d3 100644 --- a/src/compiler/vop.lisp +++ b/src/compiler/vop.lisp @@ -691,7 +691,7 @@ ;;; Boxed-Reg: any boxed register (any boxed object) ;;; Unboxed-Reg: any unboxed register (any unboxed object) ;;; Float-Reg, Double-Float-Reg: float in FP register. -;;; Stack: boxed object on the stack (on cstack) +;;; Stack: boxed object on the stack (on control stack) ;;; Word: any 32bit unboxed object on nstack. ;;; Double: any 64bit unboxed object on nstack. diff --git a/version.lisp-expr b/version.lisp-expr index c6098ca..0f2157b 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.1.39" +"0.7.1.40"