projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.7.9.42:
[sbcl.git]
/
src
/
code
/
toplevel.lisp
diff --git
a/src/code/toplevel.lisp
b/src/code/toplevel.lisp
index
1348ad7
..
f4baf40
100644
(file)
--- a/
src/code/toplevel.lisp
+++ b/
src/code/toplevel.lisp
@@
-65,7
+65,8
@@
(/show0 "back from INFINITE-ERROR-PROTECTOR")
(let ((*current-error-depth* (1+ *current-error-depth*)))
(/show0 "in INFINITE-ERROR-PROTECT, incremented error depth")
(/show0 "back from INFINITE-ERROR-PROTECTOR")
(let ((*current-error-depth* (1+ *current-error-depth*)))
(/show0 "in INFINITE-ERROR-PROTECT, incremented error depth")
- #+sb-show (sb-debug:backtrace)
+ ;; arbitrary truncation
+ #!+sb-show (sb!debug:backtrace 8)
,@forms)))
;;; a helper function for INFINITE-ERROR-PROTECT
,@forms)))
;;; a helper function for INFINITE-ERROR-PROTECT
@@
-215,7
+216,7
@@
(type (unsigned-byte 20) count)
(values (unsigned-byte 20)))
(let ((loc (int-sap (- (sap-int ptr) (+ offset sb!vm:n-word-bytes)))))
(type (unsigned-byte 20) count)
(values (unsigned-byte 20)))
(let ((loc (int-sap (- (sap-int ptr) (+ offset sb!vm:n-word-bytes)))))
- (cond ((<= (sap-int loc) end-of-stack) 0)
+ (cond ((< (sap-int loc) end-of-stack) 0)
((= offset bytes-per-scrub-unit)
(look (int-sap (- (sap-int ptr) bytes-per-scrub-unit))
0 count))
((= offset bytes-per-scrub-unit)
(look (int-sap (- (sap-int ptr) bytes-per-scrub-unit))
0 count))
@@
-228,7
+229,7
@@
(type (unsigned-byte 20) count)
(values (unsigned-byte 20)))
(let ((loc (int-sap (- (sap-int ptr) offset))))
(type (unsigned-byte 20) count)
(values (unsigned-byte 20)))
(let ((loc (int-sap (- (sap-int ptr) offset))))
- (cond ((<= (sap-int loc) end-of-stack) 0)
+ (cond ((< (sap-int loc) end-of-stack) 0)
((= offset bytes-per-scrub-unit)
count)
((zerop (sb!kernel::get-lisp-obj-address (stack-ref loc 0)))
((= offset bytes-per-scrub-unit)
count)
((zerop (sb!kernel::get-lisp-obj-address (stack-ref loc 0)))
@@
-259,7
+260,10
@@
"Evaluate FORM, returning whatever it returns and adjusting ***, **, *,
+++, ++, +, ///, //, /, and -."
(setf - form)
"Evaluate FORM, returning whatever it returns and adjusting ***, **, *,
+++, ++, +, ///, //, /, and -."
(setf - form)
- (let ((results (multiple-value-list (eval form))))
+ (let ((results
+ (multiple-value-list
+ (eval-in-lexenv form
+ (make-null-interactive-lexenv)))))
(setf /// //
// /
/ results
(setf /// //
// /
/ results
@@
-496,7
+500,7
@@
;; get you out to here.
(with-simple-restart
(abort
;; get you out to here.
(with-simple-restart
(abort
- "Reduce debugger level (leaving debugger, returning to toplevel).")
+ "~@<Reduce debugger level (leaving debugger, returning to toplevel).~@:>")
(catch 'toplevel-catcher
#!-sunos (sb!unix:unix-sigsetmask 0) ; FIXME: What is this for?
;; in the event of a control-stack-exhausted-error, we should
(catch 'toplevel-catcher
#!-sunos (sb!unix:unix-sigsetmask 0) ; FIXME: What is this for?
;; in the event of a control-stack-exhausted-error, we should