"*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"
(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))
(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
(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
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~%"
#+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)
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))
#!-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)
(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)
(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
(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 "~@<ordinary control stack soft limit temporarily displaced to ~
allow possible interactive debugging~@:>")
- (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
;;; 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.
;;; 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"
projects / sbcl.git / commitdiff