add merge in Ron's 11/21/2020 lispcore
This commit is contained in:
Larry Masinter
128
CLTL2/CMLLOAD
Normal file
128
CLTL2/CMLLOAD
Normal file
@@ -0,0 +1,128 @@
|
||||
(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
|
||||
Reference in New Issue
Block a user