1
;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
3
;; This file is part of GNU Common Lisp, herein referred to as GCL
5
;; GCL is free software; you can redistribute it and/or modify it under
6
;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
7
;; the Free Software Foundation; either version 2, or (at your option)
10
;; GCL is distributed in the hope that it will be useful, but WITHOUT
11
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
12
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
13
;; License for more details.
15
;; You should have received a copy of the GNU Library General Public License
16
;; along with GCL; see the file COPYING. If not, write to the Free Software
17
;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
;;;; Top-level loop, break loop, and error handlers
24
;;;; Revised on July 11, by Carl Hoffman.
29
(export '(+ ++ +++ - * ** *** / // ///))
30
(export '(break warn))
31
(export '*break-on-warnings*)
32
(export '*break-enable*)
36
(export '*break-readtable*)
37
(export '(loc *debug-print-level*))
39
(export '(vs ihs-vs ihs-fun frs-vs frs-bds frs-ihs bds-var bds-val super-go))
41
(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))
43
(defvar *command-args* nil)
58
;; setup file search and autoload
60
(defvar *fixed-load-path* nil)
61
(defvar *load-path* nil)
62
(defvar *load-types* '(".o" ".lsp" ".lisp"))
64
(defvar *lisp-initialized* nil)
65
(defvar *quit-tag* (cons nil nil))
66
(defvar *quit-tags* nil)
67
(defvar *break-level* '())
68
(defvar *break-env* nil)
71
(defvar *current-ihs* 1)
74
(defvar *break-enable* t)
75
(defvar *break-message* "")
77
(defvar *break-on-warnings* nil)
79
(defvar *break-readtable* nil)
81
(defvar *top-level-hook* nil)
84
(defvar *top-eof* (cons nil nil))
85
(defvar *no-prompt* nil)
88
(let ((+ nil) (++ nil) (+++ nil)
90
(* nil) (** nil) (*** nil)
91
(/ nil) (// nil) (/// nil)
93
(setq *lisp-initialized* t)
97
(*multiply-stacks* (setq *multiply-stacks* nil))
98
((probe-file "init.lsp") (load "init.lsp")))
99
(let (*load-verbose*) (process-some-args *command-args*))
101
(and (functionp *top-level-hook*)(funcall *top-level-hook*)))
104
(setq +++ ++ ++ + + -)
105
(if *no-prompt* (setq *no-prompt* nil)
107
(if (eq *package* (find-package 'user)) ""
108
(package-name *package*))))
110
;; have to exit and re-enter to multiply stacks
111
(cond (*multiply-stacks* (Return-from top-level)))
112
(when (catch *quit-tag*
113
(setq - (locally (declare (notinline read))
114
(read *standard-input* nil *top-eof*)))
115
(when (eq - *top-eof*) (bye))
116
(let ((values (multiple-value-list
117
(locally (declare (notinline eval)) (eval -)))))
118
(setq /// // // / / values *** ** ** * * (car /))
121
(locally (declare (notinline prin1)) (prin1 val))
124
(setq *evalhook* nil *applyhook* nil)
125
(terpri *error-output*)
128
(defun process-some-args (args)
132
(cond ((equal x "-load")
133
(load (second args)))
135
(eval (read-from-string (second args))))
137
(or y (setq args (cdr args)))
138
(setq args (cdr args)))
139
(or args (return nil))))
145
(defun dbl-read (&optional (stream *standard-input*) (eof-error-p t)
146
(eof-value nil) &aux tem ch)
149
(setq ch (read-char stream eof-error-p eof-value))
150
(cond ((eql ch #\newline) (go top))
151
((eq ch eof-value) (return-from dbl-read eof-value)))
152
(unread-char ch stream))
158
(read-line stream eof-error-p eof-value)")"))
159
(read (make-string-input-stream tem)
160
eof-error-p eof-value))
161
(t (read stream eof-error-p eof-value))))
164
(defun break-level (at &optional env)
165
(let* ((*break-message* (if (stringp at) at *break-message*))
166
(*quit-tags* (cons (cons *break-level* *quit-tag*) *quit-tags*))
167
(*quit-tag* (cons nil nil))
168
(*break-level* (if (not at) *break-level* (cons t *break-level*)))
169
(*ihs-base* (1+ *ihs-top*))
170
(*ihs-top* (1- (ihs-top)))
171
(*current-ihs* *ihs-top*)
172
(*frs-base* (or (sch-frs-base *frs-top* *ihs-base*) (1+ (frs-top))))
173
(*frs-top* (frs-top))
178
(if (stringp at) nil be)))
179
;(*standard-input* *terminal-io*)
180
(*readtable* (or *break-readtable* *readtable*))
181
(*read-suppress* nil)
182
(+ +) (++ ++) (+++ +++)
184
(* *) (** **) (*** ***)
185
(/ /) (// //) (/// ///)
187
; (terpri *error-output*)
188
(unless (or be (not (stringp at)))
190
(break-quit (length (cdr *break-level*))))
192
(setq *interrupt-enable* t)
193
(cond ((stringp at) (set-current)(terpri *error-output*)
194
(setq *no-prompt* nil)
196
(t (set-back at env)))
198
(setq +++ ++ ++ + + -)
199
(cond (*no-prompt* (setq *no-prompt* nil))
201
(format *debug-io* "~&~a~a>~{~*>~}"
202
(if (stringp at) "" "dbl:")
203
(if (eq *package* (find-package 'user)) ""
204
(package-name *package*))
206
(force-output *error-output*)
208
(catch 'step-continue
210
(setq - (locally (declare (notinline read))
211
(dbl-read *debug-io* nil *top-eof*)))
212
(when (eq - *top-eof*) (bye -1))
213
(let* ( break-command
216
(LOCALLY (declare (notinline break-call evalhook))
217
(if (keywordp -)(setq - (cons - nil)))
218
(cond ((and (consp -) (keywordp (car -)))
219
(setq break-command t)
220
(break-call (car -) (cdr -) 'si::break-command))
221
(t (evalhook - nil nil *break-env*)))))))
222
(and break-command (eq (car values) :resume )(return))
223
(setq /// // // / / values *** ** ** * * (car /))
224
(fresh-line *debug-io*)
226
(locally (declare (notinline prin1)) (prin1 val *debug-io*))
227
(terpri *debug-io*)))
232
(defvar *debug-print-level* 3)
234
(defun warn (format-string &rest args)
235
(let ((*print-level* 4)
237
(*print-case* :upcase))
238
(cond (*break-on-warnings*
239
(apply #'break format-string args))
240
(t (format *error-output* "~&Warning: ")
241
(let ((*indent-formatted-output* t))
242
(apply #'format *error-output* format-string args))
245
(defun universal-error-handler
246
(error-name correctable function-name
247
continue-format-string error-format-string
248
&rest args &aux message)
249
(declare (ignore error-name))
250
(let ((*print-pretty* nil)
251
(*print-level* *debug-print-level*)
252
(*print-length* *debug-print-level*)
253
(*print-case* :upcase))
254
(terpri *error-output*)
255
(cond ((and correctable *break-enable*)
256
(format *error-output* "~&Correctable error: ")
257
(let ((*indent-formatted-output* t))
258
(apply 'format *error-output* error-format-string args))
259
(terpri *error-output*)
260
(setq message (apply 'format nil error-format-string args))
262
(format *error-output*
263
"Signalled by ~:@(~S~).~%" function-name)
264
(format *error-output*
265
"Signalled by an anonymous function.~%"))
266
(format *error-output* "~&If continued: ")
267
(let ((*indent-formatted-output* t))
268
(format *error-output* "~?~&" continue-format-string args))
271
(format *error-output* "~&Error: ")
272
(let ((*indent-formatted-output* t))
273
(apply 'format *error-output* error-format-string args))
274
(terpri *error-output*)
275
(if (> (length *link-array*) 0)
276
(format *error-output* "Fast links are on: do (si::use-fast-links nil) for debugging~%"))
277
(setq message (apply 'format nil error-format-string args))
279
(format *error-output*
280
"Error signalled by ~:@(~S~).~%" function-name)
281
(format *error-output*
282
"Error signalled by an anonymous function.~%")))))
283
(force-output *error-output*)
284
(break-level message)
285
(unless correctable (throw *quit-tag* *quit-tag*)))
287
(defun break (&optional format-string &rest args &aux message)
288
(let ((*print-pretty* nil)
291
(*print-case* :upcase))
292
(terpri *error-output*)
294
(format *error-output* "~&Break: ")
295
(let ((*indent-formatted-output* t))
296
(apply 'format *error-output* format-string args))
297
(terpri *error-output*)
298
(setq message (apply 'format nil format-string args)))
299
(t (format *error-output* "~&Break.~%")
301
(let ((*break-enable* t)) (break-level message))
304
(defun terminal-interrupt (correctablep)
305
(let ((*break-enable* t))
307
(cerror "Type :r to resume execution, or :q to quit to top level."
308
"Console interrupt.")
309
(error "Console interrupt -- cannot continue."))))
312
(defun break-call (key args &optional (prop 'si::break-command) &aux fun)
313
(setq fun (complete-prop key 'keyword prop))
314
(or fun (return-from break-call nil))
315
(setq fun (get fun prop))
317
(setq args (cons fun args))
318
(or (symbolp fun) (setq args (cons 'funcall args)))
319
(evalhook args nil nil *break-env*)
321
(t (format *debug-io* "~&~S is undefined break command.~%" key))))
323
(defun break-quit (&optional (level 0)
324
&aux (current-level (length *break-level*)))
325
(when (and (>= level 0) (< level current-level))
326
(let ((x (nth (- current-level level 1) *quit-tags*)))
327
(throw (cdr x) (cdr x))))
330
(defun break-previous (&optional (offset 1))
331
(do ((i (1- *current-ihs*) (1- i)))
332
((or (< i *ihs-base*) (<= offset 0))
335
(when (ihs-visible i)
336
(setq *current-ihs* i)
337
(setq offset (1- offset)))))
339
(defun set-current ()
340
(do ((i *current-ihs* (1- i)))
341
((or (ihs-visible i) (<= i *ihs-base*))
342
(setq *current-ihs* i)
344
(format *debug-io* "Broken at ~:@(~S~).~:[ Type :H for Help.~;~]"
345
(ihs-fname *current-ihs*)
346
(cdr *break-level*)))))
348
(defun break-next (&optional (offset 1))
349
(do ((i *current-ihs* (1+ i)))
350
((or (> i *ihs-top*) (< offset 0))
353
(when (ihs-visible i)
354
(setq *current-ihs* i)
355
(setq offset (1- offset)))))
357
(defun break-go (ihs-index)
358
(setq *current-ihs* (min (max ihs-index *ihs-base*) *ihs-top*))
359
(if (ihs-visible *current-ihs*)
360
(progn (set-env) (break-current))
363
(defun break-message ()
364
(princ *break-message* *debug-io*)
368
(defun describe-environment (&optional (env *break-env*) (str *debug-io*))
369
(or (eql (length env) 3) (error "bad env"))
370
(let ((fmt "~a~#[none~;~S~;~S and ~S~
371
~:;~@{~#[~;and ~]~S~^, ~}~].~%"))
372
(apply 'format str fmt "Local variables: "
373
(mapcar #'car (car *break-env*)))
374
(apply 'format str fmt "Local functions: "
375
(mapcar #'car (cadr *break-env*)))
376
(apply 'format str fmt "Local blocks: "
377
(mapcan #'(lambda (x) (when (eq (cadr x) 'block) (list (car x))))
378
(caddr *break-env*)))
379
(apply 'format str fmt "Local tags: "
380
(mapcan #'(lambda (x) (when (eq (cadr x) 'tag) (list (car x))))
381
(caddr *break-env*)))))
383
(defun break-vs (&optional (x (ihs-vs *ihs-base*)) (y (ihs-vs *ihs-top*)))
384
(setq x (max x (ihs-vs *ihs-base*)))
385
(setq y (min y (1- (ihs-vs (1+ *ihs-top*)))))
386
(do ((ii *ihs-base* (1+ ii)))
387
((or (>= ii *ihs-top*) (>= (ihs-vs ii) x))
392
(when (ihs-visible ii) (print-ihs ii))
394
(format *debug-io* "~&VS[~d]: ~s" vi (vs vi))))))
396
(defun break-local (&optional (n 0) &aux (x (+ (ihs-vs *current-ihs*) n)))
399
(defun break-bds (&rest vars &aux (fi *frs-base*))
400
(do ((bi (1+ (frs-bds (1- *frs-base*))) (1+ bi))
401
(last (frs-bds (1+ *frs-top*))))
402
((> bi last) (values))
403
(when (or (null vars) (member (bds-var bi) vars))
405
((or (> fi *frs-top*) (> (frs-bds fi) bi)))
408
(format *debug-io* "~&BDS[~d]: ~s = ~s"
409
bi (bds-var bi) (bds-val bi)))))
411
(defun simple-backtrace ()
412
(princ "Backtrace: " *debug-io*)
413
(do* ((i *ihs-base* (1+ i))
415
((> i *ihs-top*) (terpri *debug-io*) (values))
416
(when (ihs-visible i)
417
(when b (princ " > " *debug-io*))
418
(write (ihs-fname i) :stream *debug-io* :escape t
419
:case (if (= i *current-ihs*) :upcase :downcase)))))
421
(defun ihs-backtrace (&optional (from *ihs-base*) (to *ihs-top*))
422
(setq from (max from *ihs-base*))
423
(setq to (min to *ihs-top*))
424
(do* ((i from (1+ i))
425
(j (or (sch-frs-base *frs-base* from) (1+ *frs-top*))))
427
(when (ihs-visible i) (print-ihs i))
428
(do () ((or (> j *frs-top*) (> (frs-ihs j) i)))
432
(defun print-ihs (i &aux (*print-level* 2) (*print-length* 4))
433
(format t "~&~:[ ~;@ ~]IHS[~d]: ~s ---> VS[~d]"
436
(let ((fun (ihs-fun i)))
437
(cond ((or (symbolp fun) (compiled-function-p fun)) fun)
441
((lambda-block lambda-block-expanded) (cdr fun))
442
(lambda-closure (cons 'lambda (cddddr fun)))
443
(lambda-block-closure (cddddr fun))
445
((and (symbolp (car fun))
446
(or (special-form-p(car fun))
447
(fboundp (car fun))))
455
(format *debug-io* "~& FRS[~d]: ~s ---> IHS[~d],VS[~d],BDS[~d]"
456
i (frs-kind i) (frs-ihs i) (frs-vs i) (frs-bds i)))
458
(defun frs-kind (i &aux x)
461
(if (spicep (frs-tag i))
462
(or (and (setq x (member (frs-tag i) (vs (+ (frs-vs i) 2))
463
:key #'caddr :test #'eq))
464
(if (eq (cadar x) 'block)
465
`(block ,(caar x) ***)
466
`(tagbody ,@(reverse (mapcar #'car
467
(remove (frs-tag i) x
471
`(block/tagbody ,(frs-tag i)))
472
`(catch ',(frs-tag i) ***)))
473
(:protect '(unwind-protect ***))
474
(t `(system-internal-catcher ,(frs-tag i)))))
476
(defun break-current ()
478
(format *debug-io* "Broken at ~:@(~S~)." (ihs-fname *current-ihs*))
479
(format *debug-io* "~&Top level."))
484
(defvar *break-hidden-packages* nil)
486
(defun ihs-visible (i &aux (tem (ihs-fname i)))
487
(and tem (not (member tem *break-hidden-packages*))))
490
(defun ihs-fname (ihs-index)
491
(let ((fun (ihs-fun ihs-index)))
492
(cond ((symbolp fun) fun)
496
((lambda-block lambda-block-expanded) (cadr fun))
497
(lambda-block-closure (nth 4 fun))
498
(lambda-closure 'lambda-closure)
499
(t (if (and (symbolp (car fun))
500
(or (special-form-p (car fun))
501
(fboundp (car fun))))
504
((compiled-function-p fun)
505
(compiled-function-name fun))
508
(defun ihs-not-interpreted-env (ihs-index)
509
(let ((fun (ihs-fun ihs-index)))
510
(cond ((and (consp fun)
512
;(<= (ihs-vs ihs-index) (ihs-vs (- ihs-index 1)))
519
(if (ihs-not-interpreted-env *current-ihs*)
521
(let ((i (ihs-vs *current-ihs*)))
522
(list (vs i) (vs (1+ i)) (vs (+ i 2)))))))
524
(defun list-delq (x l)
526
((eq x (car l)) (cdr l))
527
(t (rplacd l (list-delq x (cdr l))))))
529
(defun super-go (i tag &aux x)
530
(when (and (>= i *frs-base*) (<= i *frs-top*) (spicep (frs-tag i)))
531
(if (setq x (member (frs-tag i) (vs (+ (frs-vs i) 2))
532
:key #'caddr :test #'eq))
533
; Interpreted TAGBODY.
534
(when (and (eq (cadar x) 'tag)
535
(member tag (mapcar #'car (remove (frs-tag i) x
538
(internal-super-go (frs-tag i) tag t))
539
; Maybe, compiled cross-closure TAGBODY.
540
; But, it may also be compiled cross-closure BLOCK, in which case
541
; SUPER-GO just RETURN-FROMs with zero values.
542
(internal-super-go (frs-tag i) tag nil)))
543
(format *debug-io* "~s is invalid tagbody identification for ~s." i tag))
545
(defun break-backward-search-stack (sym &aux string)
546
(setq string (string sym))
547
(do* ((ihs (1- *current-ihs*) (1- ihs))
548
(fname (ihs-fname ihs) (ihs-fname ihs)))
550
(format *debug-io* "Search for ~a failed.~%" string))
551
(when (and (ihs-visible ihs)
552
(search string (symbol-name fname) :test #'char-equal))
556
(defun break-forward-search-stack (sym &aux string)
557
(setq string (string sym))
558
(do* ((ihs (1+ *current-ihs*) (1+ ihs))
559
(fname (ihs-fname ihs) (ihs-fname ihs)))
561
(format *debug-io* "Search for ~a failed.~%" string))
562
(when (and (ihs-visible ihs)
563
(search string (symbol-name fname) :test #'char-equal))
568
(putprop :b 'simple-backtrace 'break-command)
569
(putprop :r '(lambda () :resume) 'break-command)
570
(putprop :resume (get :r 'break-command) 'break-command)
571
(putprop :bds 'break-bds 'break-command)
572
(putprop :blocks 'break-blocks 'break-command)
573
(putprop :bs 'break-backward-search-stack 'break-command)
574
(putprop :c 'break-current 'break-command)
575
(putprop :fs 'break-forward-search-stack 'break-command)
576
(putprop :functions 'break-functions 'break-command)
577
(putprop :go 'break-go 'break-command)
578
(putprop :h 'break-help 'break-command)
579
(putprop :help 'break-help 'break-command)
580
(putprop :ihs 'ihs-backtrace 'break-command)
581
(putprop :env '(lambda () (describe-environment *break-env*)) 'break-command)
582
(putprop :m 'break-message 'break-command)
583
(putprop :n 'break-next 'break-command)
584
(putprop :p 'break-previous 'break-command)
585
(putprop :q 'break-quit 'break-command)
586
(putprop :s 'break-backward-search-stack 'break-command)
587
(putprop :vs 'break-vs 'break-command)
591
Break-loop Command Summary ([] indicates optional arg)
592
--------------------------
594
:bl [j] show local variables and their values, or segment of vs if compiled
595
in j stack frames starting at the current one.
596
:bt [n] BACKTRACE [n steps]
597
:down [i] DOWN i frames (one if no i)
598
:env describe ENVIRONMENT of this stack frame (for interpreted).
600
:loc [i] return i'th local of this frame if its function is compiled (si::loc i)
602
":r RESUME (return from the current break loop).
603
:up [i] UP i frames (one if no i)
605
Example: print a bactrace of the last 4 frames
609
Note: (use-fast-links nil) makes all non system function calls
610
be recorded in the stack. (use-fast-links t) is the default
614
:p [i] make current the i'th PREVIOUS frame (in list show by :b)
615
:n [i] make current the i'th NEXT frame (in list show by :b)
616
:go [ihs-index] make current the frame corresponding ihs-index
618
":m print the last break message.
619
:c show function of the current ihs frame.
620
:q [i] quit to top level
621
:r resume from this break loop.
622
:b full backtrace of all functions and special forms.
623
:bs [name] backward search for frame named 'name'
624
:fs [name] search for frame named 'name'
625
:vs [from] [to] Show value stack between FROM and TO
626
:ihs [from] [to] Show Invocation History Stack
629
:bds ['v1 'v2 ..]Show previous special bindings of v1, v2,.. or all if no v1
631
")) (format *debug-io* v))
632
(format *debug-io* "~%Here is a COMPLETE list of bindings. Too
633
add a new one, add a 'si::break-command property:")
634
(do-symbols (v (find-package "KEYWORD"))
635
(cond ((get v 'si::break-command)
637
"~%~(~a -- ~a~)" v (get v 'si::break-command)))))
642
;;make sure '/' terminated
644
(defun coerce-slash-terminated (v )
646
(or (stringp v) (error "not a string ~a" v))
647
(let ((n (length v)))
649
(unless (and (> n 0) (eql
650
(the character(aref v (the fixnum (- n 1)))) #\/))
651
(setf v (format nil "~a/" v))))
653
(defun fix-load-path (l)
654
(when (not (equal l *fixed-load-path*))
657
(setf (car x) (coerce-slash-terminated (car x))))
662
(cond ((equal (cadr w) (car v))
663
(setf (cdr w)(cddr w)))))))
664
(setq *fixed-load-path* l))
666
(defun file-search (NAME &optional (dirs *load-path*)
667
(extensions *load-types*) (fail-p t) &aux tem)
668
"Search for NAMME in DIRS with EXTENSIONS.
669
First directory is checked for first name and all extensions etc."
672
(dolist (e extensions)
673
(if (probe-file (setq tem (si::string-concatenate v name e)))
674
(return-from file-search tem))))
677
(declare (special *path*))
679
"Do (setq si::*path* \"pathname\") for path to use then :r to continue"
680
"Lookup failed in directories:~s for name ~s with extensions ~s"
681
dirs name extensions)
685
(load (file-search path *load-path* *load-types*)))
687
(defun autoload (sym path &aux (si::*ALLOW-GZIPPED-FILE* t))
689
(setf (symbol-function sym)
694
(defun autoload-macro (sym path &aux (si::*ALLOW-GZIPPED-FILE* t))
696
(setf (macro-function sym)
699
(funcall sym form env)))))
701
(eval-when (compile) (proclaim '(optimize (safety 0))) )
702
(defvar si::*command-args* nil)
703
(defun si::get-command-arg (a &optional val-if-there &aux (v *command-args*))
705
;; return non nil if annnnxu is in si::*command-args* and return
706
;; the string which is after it if there is one"
711
(declare (string str))
712
(if (and (eql (aref str 0) (aref a 0))
713
(eql (aref str 1) (aref a 1))
717
((cadr v)(values (cadr v) (cdr v)))
720
; (let ((tem (member a si::*command-args* :test 'equal)))
721
; (if tem (or val-if-there (cadr tem) t))))
723
(defun set-dir (sym flag)
724
(let ((tem (or (si::get-command-arg flag) (and (boundp sym) (symbol-value sym)))))
725
(if tem (set sym (si::coerce-slash-terminated tem)))))
727
(defun set-up-top-level ( &aux (i (si::argc)) tem)
729
(loop (setq i (- i 1))
730
(cond ((< i 0)(return nil))
731
(t (setq tem (cons (argv i) tem)))))
732
(setq *command-args* tem)
733
(setq tem *lib-directory*)
734
(let ((dir (si::getenv "GCL_LIBDIR")))
735
(or (set-dir 'si::*lib-directory* "-libdir")
736
(if dir (setq *lib-directory* (coerce-slash-terminated dir))))
738
(and *load-path* (equal tem *lib-directory*))
739
(setq *load-path* (cons (si::string-concatenate *lib-directory*
740
"lsp/") *load-path*))
741
(setq *load-path* (cons (si::string-concatenate *lib-directory*
742
"mod/") *load-path*))
743
(setq *load-path* (cons (si::string-concatenate *lib-directory*
744
"gcl-tk/") *load-path*))
746
(when (not (boundp 'si::*system-directory*))
747
(setq si::*system-directory* (namestring
748
(truename (make-pathname :name nil :type nil :defaults (si::argv 0))))))
749
(set-dir 'si::*system-directory* "-dir")
750
(if (multiple-value-setq (tem tem) (get-command-arg "-f"))
751
(let (*load-verbose*)
752
(si::process-some-args si::*command-args*)
753
(setq si::*command-args* tem)
754
(si::do-f (car si::*command-args*))))
758
(let ((eof '(nil)) tem
761
(with-open-file (st file)
764
(SETQ TEM (READ ST NIL EOF))
765
(COND ((EQ EOF TEM) (return nil)))
added
removed
lsp/gcl_top.lsp
