/[cmucl]/src/code/lispinit.lisp
ViewVC logotype

Diff of /src/code/lispinit.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.49.2.5 by dtc, Mon Oct 16 17:33:37 2000 UTC revision 1.49.2.6 by pw, Sat Mar 23 18:50:03 2002 UTC
# Line 84  Line 84 
84  ;;; Determine if key-list is a valid list of keyword/value pairs.  Do not  ;;; Determine if key-list is a valid list of keyword/value pairs.  Do not
85  ;;; signal the error directly, 'cause we don't know how it should be signaled.  ;;; signal the error directly, 'cause we don't know how it should be signaled.
86  ;;;  ;;;
87    
88  (defun verify-keywords (key-list valid-keys allow-other-keys)  (defun verify-keywords (key-list valid-keys allow-other-keys)
89    (do ((already-processed nil)    (do ((already-processed nil)
90         (unknown-keyword nil)         (unknown-keyword nil)
# Line 98  Line 99 
99             (return (values :dotted-list key-list)))             (return (values :dotted-list key-list)))
100            ((null (cdr remaining))            ((null (cdr remaining))
101             (return (values :odd-length key-list)))             (return (values :odd-length key-list)))
102              #+nil ;; Not ANSI compliant to disallow duplicate keywords.
103            ((member (car remaining) already-processed)            ((member (car remaining) already-processed)
104             (return (values :duplicate (car remaining))))             (return (values :duplicate (car remaining))))
105            ((or (eq (car remaining) :allow-other-keys)            ((or (eq (car remaining) :allow-other-keys)
# Line 257  Line 259 
259  ;;; %End-Of-The-World.  We quit this way so that all outstanding cleanup forms  ;;; %End-Of-The-World.  We quit this way so that all outstanding cleanup forms
260  ;;; in Unwind-Protects will get executed.  ;;; in Unwind-Protects will get executed.
261    
262  (proclaim '(special *lisp-initialization-functions*  (declaim (special *lisp-initialization-functions*
263                      *load-time-values*))                    *load-time-values*))
264    
265  (eval-when (compile)  (eval-when (compile)
266    (defmacro print-and-call (name)    (defmacro print-and-call (name)
# Line 431  Line 433 
433    
434  ;;;; Miscellaneous external functions:  ;;;; Miscellaneous external functions:
435    
436    (defvar *cleanup-functions* nil
437      "Functions to be invoked during cleanup at Lisp exit.")
438    
439  ;;; Quit gets us out, one way or another.  ;;; Quit gets us out, one way or another.
440    
441  (defun quit (&optional recklessly-p)  (defun quit (&optional recklessly-p)
# Line 438  Line 443 
443    non-Nil."    non-Nil."
444    (if recklessly-p    (if recklessly-p
445        (unix:unix-exit 0)        (unix:unix-exit 0)
446        (throw '%end-of-the-world 0)))        (progn
447            (mapc (lambda (fn) (ignore-errors (funcall fn))) *cleanup-functions*)
448            (throw '%end-of-the-world 0))))
449    
450    
451  #-mp ; Multi-processing version defined in multi-proc.lisp.  #-mp ; Multi-processing version defined in multi-proc.lisp.
# Line 453  Line 460 
460    (multiple-value-bind (sec usec)    (multiple-value-bind (sec usec)
461      (if (integerp n)      (if (integerp n)
462          (values n 0)          (values n 0)
463          (multiple-value-bind (sec frac)(truncate n)          (multiple-value-bind (sec frac) (truncate n)
464            (values sec(truncate frac 1e-6))))            (values sec (truncate frac 1e-6))))
465      (unix:unix-select 0 0 0 0 sec usec))      (unix:unix-select 0 0 0 0 sec usec))
466    nil)    nil)
467    
# Line 536  Line 543 
543    "Evaluate FORM, returning whatever it returns but adjust ***, **, *, +++, ++,    "Evaluate FORM, returning whatever it returns but adjust ***, **, *, +++, ++,
544    +, ///, //, /, and -."    +, ///, //, /, and -."
545    (setf - form)    (setf - form)
546    (let ((results (multiple-value-list (eval form))))    (let ((results (multiple-value-list
547                      (if (and (fboundp 'commandp)(funcall 'commandp form))
548                          (funcall 'invoke-command-interactive form)
549                          (eval form)))))
550      (finish-standard-output-streams)      (finish-standard-output-streams)
551      (setf /// //      (setf /// //
552            // /            // /

Legend:
Removed from v.1.49.2.5  
changed lines
  Added in v.1.49.2.6

  ViewVC Help
Powered by ViewVC 1.1.5