(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)

(FILECREATED "18-Oct-93 14:18:07" "{Pele:mv:envos}<LispCore>Sources>CLTL2>CMLLOAD.;2"
 6602   

      |previous| |date:| "15-Dec-92 21:27:17" "{Pele:mv:envos}<LispCore>Sources>CLTL2>CMLLOAD.;1")


; Copyright (c) 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Venue & Xerox Corporation.  All rights reserved.

(PRETTYCOMPRINT CMLLOADCOMS)

(RPAQQ CMLLOADCOMS
 ((VARIABLES LISP:*LOAD-PRINT* *LOAD-VERBOSE* LISP:*LOAD-PATHNAME* 
                               LISP:*LOAD-TRUENAME* XCL::*DEFAULT-SOURCE-IO-PACKAGE*)
                        (FUNCTIONS LISP::DEFAULT-IO-PACKAGE LISP:LOAD LISP::\\OPENSTREAM-WITH-DEFAULT
                               )
                        (FNS \\CML-LOAD)
                        (PROP FILETYPE CMLLOAD)))

(LISP:DEFVAR LISP:*LOAD-PRINT*
 NIL
   "Default value for :PRINT in LOAD")

(LISP:DEFVAR *LOAD-VERBOSE*
 T
   "Default for VERBOSE keyword to LOAD.")

(LISP:DEFVAR LISP:*LOAD-PATHNAME*
 NIL
   "LOAD binds this to the pathname of the file being loaded")

(LISP:DEFVAR LISP:*LOAD-TRUENAME*
 NIL
   "LOAD binds this to the truename of the file being loaded")

(LISP:DEFVAR XCL::*DEFAULT-SOURCE-IO-PACKAGE*
 (LISP:FIND-PACKAGE "CL-USER"))

(LISP:DEFUN LISP::DEFAULT-IO-PACKAGE
 (LISP::P)           (* \; "Edited 15-Dec-92 16:06 by jrb:")


   (* |;;| "P is the argument given to the :PACKAGE keyword for any of the functions that get their package defaulted (CL:LOAD, CL:COMPILE-FILE).  The intent is that if P is supplied it is an absolute override; if not we fall back on CLtL2 if XCL:*CLTL2-PEDANTIC* is on; if that doesn't work we try XCL::*DEFAULT-SOURCE-IO-PACKAGE* and we punt if THAT loses.")


   (COND
      ((NULL LISP::P)
       (COND
          (*CLTL2-PEDANTIC* *PACKAGE*)
          ((LISP:FIND-PACKAGE XCL::*DEFAULT-SOURCE-IO-PACKAGE*))
          (T (LISP:CERROR "Use current *PACKAGE*" 
                    "The value of XCL::*DEFAULT-SOURCE-IO-PACKAGE*, ~s, does not name a package" 
                    XCL::*DEFAULT-SOURCE-IO-PACKAGE*)
             *PACKAGE*)))
      ((LISP:FIND-PACKAGE LISP::P))
      (T (LISP:CERROR "Use current *PACKAGE*" "~s does not name a package" LISP::P)
         *PACKAGE*)))

(LISP:DEFUN LISP:LOAD
 (FILENAME &KEY ((:VERBOSE *LOAD-VERBOSE*)
                                          *LOAD-VERBOSE*)
                                 ((:PRINT LISP:*LOAD-PRINT*)
                                  LISP:*LOAD-PRINT*)
                                 (IF-DOES-NOT-EXIST :ERROR)
                                 (LOADFLG NIL)
                                 (PACKAGE NIL))            (* \; "Edited 15-Dec-92 16:06 by jrb:")

   "Loads the file named by Filename into the Lisp environment."
   (LET* ((LISP:*LOAD-PATHNAME* (LISP:IF (STREAMP FILENAME)
                                    (IGNORE-ERRORS (PATHNAME FILENAME))

                                 (* |;;| "If the current connected directory is \"{DSK}<tmp>\", (CL:LOAD \"{CORE}FOO\") should load \"{CORE}FOO\" rather than \"{CORE}<tmp>FOO\".  Thus we call MERGE-PATHNAMES iff HOST field is not specified in FILENAME. ")


                                    (LISP:IF (LISP:IF (LISP:PATHNAMEP FILENAME)
                                                 (LISP:PATHNAME-HOST FILENAME)
                                                 (FILENAMEFIELD FILENAME 'HOST))
                                        (PATHNAME FILENAME)
                                        (LISP:MERGE-PATHNAMES (PATHNAME FILENAME)
                                               *DEFAULT-PATHNAME-DEFAULTS*))))
          (LISP:*LOAD-TRUENAME* (AND LISP:*LOAD-PATHNAME* (LISP:TRUENAME LISP:*LOAD-PATHNAME*)))
          (STREAM (OR (STREAMP FILENAME)
                      (|if|
 (NULL IF-DOES-NOT-EXIST)
                          |then|
 (CONDITION-CASE (OPENSTREAM LISP:*LOAD-PATHNAME* 'INPUT
                                                            'OLD LOADPARAMETERS)
                                            (XCL:FILE-NOT-FOUND NIL 

                                                   (* |;;| 

                              "Spec says return NIL if file not found and IF-DOES-NOT-EXIST is NIL")


                                                   (LISP:RETURN-FROM LISP:LOAD NIL)))
                        |else|
 (OPENSTREAM LISP:*LOAD-PATHNAME* 'INPUT 'OLD LOADPARAMETERS)))))
         (LISP:UNWIND-PROTECT
             (\\LOAD-STREAM STREAM (LISP:INTERN (STRING LOADFLG)
                                          (LISP:FIND-PACKAGE "INTERLISP"))
                    LISP:*LOAD-PRINT*
                    (AND *LOAD-VERBOSE* *TERMINAL-IO*)
                    PACKAGE)
             (LISP:CLOSE STREAM))))

(LISP:DEFUN LISP::\\OPENSTREAM-WITH-DEFAULT
 (LISP::FILENAME)
   (DECLARE
 (LISP:SPECIAL LOADPARAMATERS))

   (* |;;| "If the current connected directory is \"{DSK}<tmp>\", (CL:LOAD \"{CORE}FOO\") should load \"{CORE}FOO\" rather than \"{CORE}<tmp>FOO\".  Thus we call MERGE-PATHNAMES iff HOST field is not specified in FILENAME. ")


   (LISP:IF (NULL (LISP:IF (LISP:PATHNAMEP LISP::FILENAME)
                      (LISP:PATHNAME-HOST LISP::FILENAME)
                      (FILENAMEFIELD LISP::FILENAME 'HOST)))
       (OPENSTREAM (LISP:MERGE-PATHNAMES (PATHNAME LISP::FILENAME)
                          *DEFAULT-PATHNAME-DEFAULTS*)
              'INPUT
              'OLD LOADPARAMETERS)
       (OPENSTREAM LISP::FILENAME 'INPUT 'OLD LOADPARAMETERS)))
(DEFINEQ

(\\CML-LOAD

  (LAMBDA (STREAM PRINTFLG LOAD-VERBOSE-STREAM PACKAGE)      (* \; "Edited  1-Aug-91 10:57 by jrb:")


    (* |;;| "Loads a \"Common Lisp file\" a la CL:LOAD.  Currently only do this if file starts with semi-colon.  PACKAGE overrides the default (USER).")


    (LET ((*PACKAGE* PACKAGE)
          (*READTABLE* CMLRDTBL)
          (FULL (FULLNAME STREAM))
          (EOF-MARK "EOF")
          EXPR)
         (|until|
 (EQ EOF-MARK (SETQ EXPR (LISP:READ STREAM NIL EOF-MARK)))
            |do|
 (COND
                        (PRINTFLG (PRINT (LISP:EVAL EXPR)
                                         T))
                        (T (LISP:EVAL EXPR))))
         (|if|
 LOAD-VERBOSE-STREAM
             |then|
 (LISP:FORMAT LOAD-VERBOSE-STREAM "; Finished loading ~A, ~D bytes read~&" 
                               FULL (GETFILEPTR STREAM)))
         FULL)))
)

(PUTPROPS CMLLOAD
 FILETYPE
 LISP:COMPILE-FILE)
(PUTPROPS CMLLOAD COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 1992 1993))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (5526 6430 (\\CML-LOAD 5536 . 6428)))))
STOP