113 |
(setq - (locally (declare (notinline read)) |
(setq - (locally (declare (notinline read)) |
114 |
(read *standard-input* nil *top-eof*))) |
(read *standard-input* nil *top-eof*))) |
115 |
(when (eq - *top-eof*) (bye)) |
(when (eq - *top-eof*) (bye)) |
116 |
|
; (si::clear-c-stack 4096) |
117 |
(let ((values (multiple-value-list |
(let ((values (multiple-value-list |
118 |
(locally (declare (notinline eval)) (eval -))))) |
(locally (declare (notinline eval)) (eval -))))) |
119 |
(setq /// // // / / values *** ** ** * * (car /)) |
(setq /// // // / / values *** ** ** * * (car /)) |
152 |
((eq ch eof-value) (return-from dbl-read eof-value))) |
((eq ch eof-value) (return-from dbl-read eof-value))) |
153 |
(unread-char ch stream)) |
(unread-char ch stream)) |
154 |
|
|
155 |
(cond ((eql #\: ch) |
(cond |
156 |
(setq tem |
; ((eql #\: ch) |
157 |
(string-concatenate |
; (setq tem |
158 |
"(" |
; (string-concatenate |
159 |
(read-line stream eof-error-p eof-value)")")) |
; "(" |
160 |
(read (make-string-input-stream tem) |
; (read-line stream eof-error-p eof-value)")")) |
161 |
eof-error-p eof-value)) |
; (read (make-string-input-stream tem) |
162 |
|
; eof-error-p eof-value)) |
163 |
(t (read stream eof-error-p eof-value)))) |
(t (read stream eof-error-p eof-value)))) |
164 |
|
|
165 |
|
|
166 |
(defun break-level (at &optional env) |
(defun break-level (at &optional env) |
167 |
(let* ((*break-message* (if (stringp at) at *break-message*)) |
(let* ((*break-message* (if (stringp at) at *break-message*)) |
168 |
(*quit-tags* (cons (cons *break-level* *quit-tag*) *quit-tags*)) |
(quit-tags1 (cons *break-level* *quit-tag*)) |
169 |
(*quit-tag* (cons nil nil)) |
(quit-tags (cons quit-tags1 *quit-tags*)) |
170 |
(*break-level* (if (not at) *break-level* (cons t *break-level*))) |
(*quit-tags* quit-tags) |
171 |
|
(quit-tag (cons nil nil)) |
172 |
|
(*quit-tag* quit-tag) |
173 |
|
(break-level (cons t *break-level*)) |
174 |
|
(*break-level* (if (not at) *break-level* break-level)) |
175 |
(*ihs-base* (1+ *ihs-top*)) |
(*ihs-base* (1+ *ihs-top*)) |
176 |
(*ihs-top* (1- (ihs-top))) |
(*ihs-top* (1- (ihs-top))) |
177 |
(*current-ihs* *ihs-top*) |
(*current-ihs* *ihs-top*) |
190 |
(* *) (** **) (*** ***) |
(* *) (** **) (*** ***) |
191 |
(/ /) (// //) (/// ///) |
(/ /) (// //) (/// ///) |
192 |
) |
) |
193 |
|
(declare (:dynamic-extent quit-tags quit-tags1 quit-tag break-level)) |
194 |
; (terpri *error-output*) |
; (terpri *error-output*) |
195 |
(unless (or be (not (stringp at))) |
(unless (or be (not (stringp at))) |
196 |
(simple-backtrace) |
(simple-backtrace) |
217 |
(setq - (locally (declare (notinline read)) |
(setq - (locally (declare (notinline read)) |
218 |
(dbl-read *debug-io* nil *top-eof*))) |
(dbl-read *debug-io* nil *top-eof*))) |
219 |
(when (eq - *top-eof*) (bye -1)) |
(when (eq - *top-eof*) (bye -1)) |
220 |
(let* ( break-command |
(let* (break-command |
221 |
(values |
(values |
222 |
(multiple-value-list |
(multiple-value-list |
223 |
(LOCALLY (declare (notinline break-call evalhook)) |
(LOCALLY (declare (notinline break-call evalhook)) |
224 |
(if (keywordp -)(setq - (cons - nil))) |
; (if (keywordp -)(setq - (cons - nil))) |
225 |
(cond ((and (consp -) (keywordp (car -))) |
(cond |
226 |
(setq break-command t) |
((keywordp -) |
227 |
(break-call (car -) (cdr -) 'si::break-command)) |
(setq break-command t) |
228 |
(t (evalhook - nil nil *break-env*))))))) |
(break-call - nil 'si::break-command)) |
229 |
|
((and (consp -) (keywordp (car -))) |
230 |
|
(setq break-command t) |
231 |
|
(break-call (car -) (cdr -) 'si::break-command)) |
232 |
|
(t (evalhook - nil nil *break-env*))))))) |
233 |
(and break-command (eq (car values) :resume )(return)) |
(and break-command (eq (car values) :resume )(return)) |
234 |
(setq /// // // / / values *** ** ** * * (car /)) |
(setq /// // // / / values *** ** ** * * (car /)) |
235 |
(fresh-line *debug-io*) |
(fresh-line *debug-io*) |
257 |
(error-name correctable function-name |
(error-name correctable function-name |
258 |
continue-format-string error-format-string |
continue-format-string error-format-string |
259 |
&rest args &aux message) |
&rest args &aux message) |
260 |
(declare (ignore error-name)) |
(declare (ignore error-name) (:dynamic-extent args)) |
261 |
(let ((*print-pretty* nil) |
(let ((*print-pretty* nil) |
262 |
(*print-level* *debug-print-level*) |
(*print-level* *debug-print-level*) |
263 |
(*print-length* *debug-print-level*) |
(*print-length* *debug-print-level*) |