From 575b12f310b69a50db544bf581a720338465b705 Mon Sep 17 00:00:00 2001 From: pw <pw> Date: Wed, 5 Feb 1997 16:15:59 +0000 Subject: [PATCH] initial post 1.3.7 merge --- code/bit-bash.lisp | 3 +- code/debug-int.lisp | 25 ++++----- code/error.lisp | 5 +- code/exports.lisp | 27 ++++++++-- code/format.lisp | 7 +-- code/irrat.lisp | 49 +++++++---------- code/load.lisp | 30 +++++------ code/macros.lisp | 20 ++++--- code/pathname.lisp | 129 +++++++++++++++++++++++--------------------- code/pred.lisp | 4 +- code/save.lisp | 6 +-- 11 files changed, 155 insertions(+), 150 deletions(-) diff --git a/code/bit-bash.lisp b/code/bit-bash.lisp index de4f47283..455c200f3 100644 --- a/code/bit-bash.lisp +++ b/code/bit-bash.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bit-bash.lisp,v 1.19 1997/01/18 14:30:33 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bit-bash.lisp,v 1.20 1997/02/05 16:15:32 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -77,7 +77,6 @@ (:big-endian big-endian) (:little-endian little-endian)))) -(proclaim '(inline shift-towards-start shift-towards-end)) (defun shift-towards-start (number count) "Shift NUMBER by COUNT bits, adding zero bits at the ``end'' and removing bits from the ``start.'' On big-endian machines this is a left-shift and diff --git a/code/debug-int.lisp b/code/debug-int.lisp index dd9188f5d..2cf2ffacc 100644 --- a/code/debug-int.lisp +++ b/code/debug-int.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.69 1997/01/18 14:31:08 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.70 1997/02/05 16:15:36 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2948,18 +2948,18 @@ (defun sub-access-debug-var-slot (fp sc-offset &optional escaped) (macrolet ((with-escaped-value ((var) &body forms) `(if escaped - (let ((,var (vm:sigcontext-register - escaped - (c::sc-offset-offset sc-offset)))) - ,@forms) - :invalid-value-for-unescaped-register-storage)) + (let ((,var (vm:sigcontext-register + escaped + (c::sc-offset-offset sc-offset)))) + ,@forms) + :invalid-value-for-unescaped-register-storage)) (escaped-float-value (format) `(if escaped - (vm:sigcontext-float-register - escaped - (c::sc-offset-offset sc-offset) - ',format) - :invalid-value-for-unescaped-register-storage)) + (vm:sigcontext-float-register + escaped + (c::sc-offset-offset sc-offset) + ',format) + :invalid-value-for-unescaped-register-storage)) (with-nfp ((var) &body body) `(let ((,var (if escaped (system:int-sap @@ -3012,8 +3012,6 @@ vm:word-bytes)))) (#.vm:control-stack-sc-number (kernel:stack-ref fp (c::sc-offset-offset sc-offset))) - (#.vm:immediate-stack-sc-number - (kernel:stack-ref fp (c::sc-offset-offset sc-offset))) (#.vm:base-char-stack-sc-number (with-nfp (nfp) (code-char (system:sap-ref-32 nfp (* (c::sc-offset-offset sc-offset) @@ -3030,7 +3028,6 @@ (with-nfp (nfp) (system:sap-ref-sap nfp (* (c::sc-offset-offset sc-offset) vm:word-bytes))))))) - #+x86 (defun sub-access-debug-var-slot (fp sc-offset &optional escaped) (declare (type system:system-area-pointer fp)) diff --git a/code/error.lisp b/code/error.lisp index 2f7ac1b41..a10c32e08 100644 --- a/code/error.lisp +++ b/code/error.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.45 1997/01/18 14:30:53 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.46 1997/02/05 16:15:41 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -759,7 +759,8 @@ `#'(lambda (condition stream) (declare (ignore condition)) (write-string ,arg stream)) - `#',arg)))) + `#'(lambda (condition stream) + (funcall #',arg condition stream)))))) (:default-initargs (do ((initargs (rest option) (cddr initargs))) ((endp initargs)) diff --git a/code/exports.lisp b/code/exports.lisp index 5a9397ce9..495fd1fbb 100644 --- a/code/exports.lisp +++ b/code/exports.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.108 1997/01/18 14:30:55 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.109 1997/02/05 16:15:46 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -249,7 +249,26 @@ "C-CFLAG" "TTY-OCRNL" "VMIN" "VEOF" "TCSAFLUSH" "TTY-IXON" "C-CC" "SIOCSPGRP" "TERMIOS" "VQUIT" "UNIX-TCSETATTR" "VINTR" "VSTART" "TIOCSIGSEND" - #+(or svr4 freebsd linux) "O_NDELAY")) + #+(or svr4 freebsd linux) "O_NDELAY") + #+(or svr4 linux) + (:export "EADDRINUSE" "EADDRNOTAVAIL" "EADV" "EAFNOSUPPORT" + "EALREADY" "EBADE" "EBADFD" "EBADMSG" "EBADR" "EBADRQC" + "EBADSLT" "EBFONT" #+svr4 "ECANCELED" "ECHRNG" "ECOMM" + "ECONNABORTED" "ECONNREFUSED" "ECONNRESET" "EDEADLK" + "EDEADLOCK" "EDESTADDRREQ" #+linux "EDOTDOT" #+linux "EDQUOT" + "EHOSTDOWN" "EHOSTUNREACH" "EIDRM" "EILSEQ" "EINPROGRESS" + "EISCONN" #+linux "EISNAM" "EL2HLT" "EL2NSYNC" "EL3HLT" + "EL3RST" "ELIBACC" "ELIBBAD" "ELIBEXEC" "ELIBMAX" "ELIBSCN" + "ELNRNG" "ELOOP" "EMSGSIZE" "EMULTIHOP" "ENAMETOOLONG" + #+linux "ENAVAIL" "ENETDOWN" "ENETRESET" "ENETUNREACH" "ENOANO" + "ENOBUFS" "ENOCSI" "ENODATA" "ENOLCK" "ENOLINK" "ENOMSG" "ENONET" + "ENOPKG" "ENOPROTOOPT" "ENOSR" "ENOSTR" "ENOSYS" "ENOTCONN" + "ENOTEMPTY" #+linux "ENOTNAM" "ENOTSOCK" #+svr4 "ENOTSUP" + "ENOTUNIQ" "EOPNOTSUPP" "EOVERFLOW" "EPFNOSUPPORT" "EPROTO" + "EPROTONOSUPPORT" "EPROTOTYPE" "EREMCHG" "EREMOTE" + #+linux "EREMOTEIO" "ERESTART" "ESHUTDOWN" "ESOCKTNOSUPPORT" + "ESRMNT" "ESTALE" "ESTRPIPE" "ETIME" "ETIMEDOUT" "ETOOMANYREFS" + #+linux "EUCLEAN" "EUNATCH" "EUSERS" "EWOULDBLOCK" "EXFULL")) (defpackage "FORMAT") (defpackage "COMMON-LISP" @@ -721,7 +740,9 @@ "FUNCALLABLE-INSTANCE-LAYOUT-SLOT" "FUNCALLABLE-INSTANCE-LEXENV-SLOT" "FP-DOUBLE-ZERO-SC-NUMBER" "FP-SINGLE-ZERO-SC-NUMBER" - "SINGLE-STEP-BREAKPOINT-TRAP")) + "SINGLE-STEP-BREAKPOINT-TRAP" + #+sparc "OBJECT-NOT-LIST-TRAP" + #+sparc "OBJECT-NOT-INSTANCE-TRAP")) (defpackage "CONDITIONS") (intern "DISASSEMBLE" "LISP") diff --git a/code/format.lisp b/code/format.lisp index 385a5814a..f6d087316 100644 --- a/code/format.lisp +++ b/code/format.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.32 1997/01/18 14:31:03 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.33 1997/02/05 16:15:49 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -136,10 +136,7 @@ (incf posn) (push (cons posn (get-char)) params)) ((char= char #\,) - (push (cons (1- posn) nil) params) - (incf posn) - (if (not (char= (get-char) #\,)) - (decf posn))) + (push (cons (1- posn) nil) params)) ((char= char #\:) (if colonp (error 'format-error diff --git a/code/irrat.lisp b/code/irrat.lisp index 4dbada9bf..80fd391ae 100644 --- a/code/irrat.lisp +++ b/code/irrat.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/irrat.lisp,v 1.17 1997/01/18 14:30:40 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/irrat.lisp,v 1.18 1997/02/05 16:15:51 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -66,9 +66,9 @@ (def-math-rtn "sinh" 1) (def-math-rtn "cosh" 1) (def-math-rtn "tanh" 1) -#-hpux (def-math-rtn "asinh" 1) -#-hpux (def-math-rtn "acosh" 1) -#-hpux (def-math-rtn "atanh" 1) +(def-math-rtn "asinh" 1) +(def-math-rtn "acosh" 1) +(def-math-rtn "atanh" 1) ;;; Exponential and Logarithmic. #-x86(def-math-rtn "exp" 1) @@ -77,6 +77,7 @@ (def-math-rtn "pow" 2) #-x86 (def-math-rtn "sqrt" 1) (def-math-rtn "hypot" 2) +#-hpux (def-math-rtn "log1p" 1) #+x86 ;; These are needed for use by byte-compiled files. @@ -241,7 +242,9 @@ (defun log (number &optional (base nil base-p)) "Return the logarithm of NUMBER in the base BASE, which defaults to e." (if base-p - (/ (log number) (log base)) + (if (zerop base) + base ; ANSI spec + (/ (log number) (log base))) (number-dispatch ((number number)) (((foreach fixnum bignum ratio)) (if (minusp number) @@ -504,32 +507,16 @@ ((complex) (complex-atanh number)))) -;;; HP-UX does not supply C versions of asinh, acosh, and atanh, so just -;;; use the definitions. +;;; HP-UX does not supply a C version of log1p, so +;;; use the definition. #+hpux -(defun %asinh (number) - (declare (type double-float number) - (values double-float) - (optimize (speed 3) (safety 0) (inhibit-warnings 3))) - (log (+ number (sqrt (+ 1.0d0 (* number number)))))) - -#+hpux -(defun %acosh (number) - (declare (type (double-float 1.0d0) number) - (values double-float) - (optimize (speed 3) (safety 0) (inhibit-warnings 3))) - (log (+ number (* (sqrt (- number 1.0d0)) - (sqrt (+ number 1.0d0)))))) - +(declaim (inline %log1p)) #+hpux -(defun %atanh (number) - (declare (type (double-float -1.0d0 1.0d0) number) - (values double-float) - (optimize (speed 3) (safety 0) (inhibit-warnings 3))) - (* 0.5d0 (- (log (+ 1.0d0 number)) - (log (- 1.0d0 number))))) - +(defun %log1p (number) + (declare (double-float number) + (optimize (speed 3) (safety 0))) + (the double-float (log (the (double-float 0d0) (+ number 1d0))))) #+old-elfun @@ -898,10 +885,10 @@ Z may be any number, but the result is always a complex." (y (float (imagpart z) 1.0d0))) (declare (double-float x y)) (cond ((> (abs x) - #-linux #.(/ (%asinh most-positive-double-float) 4d0) + #-(or linux hpux) #.(/ (%asinh most-positive-double-float) 4d0) ;; This is more accurate under linux. - #+linux #.(/ (+ (%log 2.0d0) - (%log most-positive-double-float)) 4d0)) + #+(or linux hpux) #.(/ (+ (%log 2.0d0) + (%log most-positive-double-float)) 4d0)) (complex (float-sign x) (float-sign y 0.0d0))) (t diff --git a/code/load.lisp b/code/load.lisp index 080687012..42c5317ea 100644 --- a/code/load.lisp +++ b/code/load.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.59 1997/01/18 14:30:39 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.60 1997/02/05 16:15:52 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -592,18 +592,18 @@ ;;; TRY-DEFAULT-TYPES -- Internal ;;; -(defun try-default-types (pathname types) - (dolist (type types (values nil nil)) - ;; toy@rtp.ericsson.se: add diddle-case so that this can handle - ;; both unix-namestrings and logical pathname namestrings. The - ;; case handling seems to be the opposite between these two - ;; styles. - (let* ((pn (make-pathname - :type (maybe-diddle-case - type (logical-pathname-p (pathname pathname))) - :defaults pathname)) - (tn (probe-file pn))) - (when tn (return (values pn tn)))))) +(defun try-default-types (pathname types lp-type) + ;; Modified 18-Jan-97/pw for logical-pathname support. + (flet ((frob (pathname type) + (let* ((pn (make-pathname :type type :defaults pathname)) + (tn (probe-file pn))) + (values pn tn)))) + (if (logical-pathname-p pathname) + (frob pathname lp-type) + (dolist (type types (values nil nil)) + (multiple-value-bind (pn tn)(frob pathname type) + (when tn + (return (values pn tn)))))))) ;;; INTERNAL-LOAD-DEFAULT-TYPE -- Internal ;;; @@ -612,10 +612,10 @@ (defun internal-load-default-type (pathname if-does-not-exist) (multiple-value-bind (src-pn src-tn) - (try-default-types pathname *load-source-types*) + (try-default-types pathname *load-source-types* "LISP") (multiple-value-bind (obj-pn obj-tn) - (try-default-types pathname *load-object-types*) + (try-default-types pathname *load-object-types* "FASL") (cond ((and obj-tn src-tn (> (file-write-date src-tn) (file-write-date obj-tn))) diff --git a/code/macros.lisp b/code/macros.lisp index 12365359f..0cc1e9021 100644 --- a/code/macros.lisp +++ b/code/macros.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.46 1997/01/18 14:31:12 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.47 1997/02/05 16:15:54 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1365,26 +1365,24 @@ ;;;; With-XXX - (defmacro with-open-file ((var &rest open-args) &body (forms decls)) "Bindspec is of the form (Stream File-Name . Options). The file whose name is File-Name is opened using the Options and bound to the variable - Stream. If the call to open is unsuccessful, the forms are not - evaluated. The Forms are executed, and when they terminate, normally or - otherwise, the file is closed." + Stream. If the call to open is unsuccessful, the forms are not + evaluated. The Forms are executed, and when they + terminate, normally or otherwise, the file is closed." (let ((abortp (gensym))) `(let ((,var (open ,@open-args)) (,abortp t)) ,@decls - (when ,var - (unwind-protect - (multiple-value-prog1 - (progn ,@forms) - (setq ,abortp nil)) + (unwind-protect + (multiple-value-prog1 + (progn ,@forms) + (setq ,abortp nil)) + (when ,var (close ,var :abort ,abortp)))))) - (defmacro with-open-stream ((var stream) &body (forms decls)) "The form stream should evaluate to a stream. VAR is bound to the stream and the forms are evaluated as an implicit diff --git a/code/pathname.lisp b/code/pathname.lisp index fa0f21db5..aeaa2debe 100644 --- a/code/pathname.lisp +++ b/code/pathname.lisp @@ -4,7 +4,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.27 1997/01/18 14:30:44 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.28 1997/02/05 16:15:56 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -112,7 +112,7 @@ (error "~S Cannot be printed readably." pathname)) (t (funcall (formatter "#<Unprintable pathname, Host=~S, Device=~S, ~ - Directory=~S, File=~S, Name=~S, Version=~S>") + Directory=~S, Name=~S, Type=~S, Version=~S>") stream (%pathname-host pathname) (%pathname-device pathname) @@ -178,6 +178,17 @@ (%pathname-type pathname) (%pathname-version pathname)))))) +;;; %MAKE-PATHNAME-OBJECT -- internal +;;; +;;; A pathname is logical if the host component is a logical-host. +;;; This constructor is used to make an instance of the correct type +;;; from parsed arguments. + +(defun %make-pathname-object (host device directory name type version) + (if (typep host 'logical-host) + (%make-logical-pathname host :unspecific directory name type version) + (%make-pathname host device directory name type version))) + ;;; *LOGICAL-HOSTS* --internal. ;;; ;;; Hash table searching maps a logical-pathname's host to their physical @@ -405,11 +416,14 @@ ;;; Converts the var, a host or string name for a host, into a logical-host ;;; structure or nil if not defined. ;;; +;;; pw notes 1/12/97 this potentially useful macro is not used anywhere +;;; and 'find-host' is not defined. 'find-logical-host' seems to be needed. +;;; (defmacro with-host ((var expr) &body body) `(let ((,var (let ((,var ,expr)) (typecase ,var (logical-host ,var) - (string (find-host ,var)) + (string (find-logical-host ,var nil)) (t nil))))) ,@body)) @@ -532,26 +546,22 @@ (and default-host pathname-host (not (eq (host-customary-case default-host) (host-customary-case pathname-host)))))) - (make-pathname :host (or pathname-host default-host) - :device - (or (%pathname-device pathname) - (maybe-diddle-case (%pathname-device defaults) - diddle-case)) - :directory - (merge-directories (%pathname-directory pathname) - (%pathname-directory defaults) - diddle-case) - :name - (or (%pathname-name pathname) - (maybe-diddle-case (%pathname-name defaults) - diddle-case)) - :type - (or (%pathname-type pathname) - (maybe-diddle-case (%pathname-type defaults) - diddle-case)) - :version - (or (%pathname-version pathname) - default-version)))))) + (%make-pathname-object + (or pathname-host default-host) + (or (%pathname-device pathname) + (maybe-diddle-case (%pathname-device defaults) + diddle-case)) + (merge-directories (%pathname-directory pathname) + (%pathname-directory defaults) + diddle-case) + (or (%pathname-name pathname) + (maybe-diddle-case (%pathname-name defaults) + diddle-case)) + (or (%pathname-type pathname) + (maybe-diddle-case (%pathname-type defaults) + diddle-case)) + (or (%pathname-version pathname) + default-version)))))) ;;; IMPORT-DIRECTORY -- Internal ;;; @@ -615,7 +625,25 @@ a host-structure or string." ;; toy@rtp.ericsson.se: CLHS says make-pathname can take a ;; string (as a logical-host) for the host part. We map that ;; string into the corresponding logical host structure. - (host (or (gethash host *logical-hosts*) host default-host)) + + ;; pw@snoopy.mv.com: + ;; HyperSpec says for the arg to MAKE-PATHNAME; + ;; "host---a valid physical pathname host. ..." + ;; where it probably means -- a valid pathname host. + ;; "valid pathname host n. a valid physical pathname host or + ;; a valid logical pathname host." + ;; and defines + ;; "valid physical pathname host n. any of a string, + ;; a list of strings, or the symbol :unspecific, + ;; that is recognized by the implementation as the name of a host." + ;; "valid logical pathname host n. a string that has been defined + ;; as the name of a logical host. ..." + ;; HS is silent on what happens if the :host arg is NOT one of these. + ;; It seems an error message is appropriate. + (host (typecase host + (host host) ; A valid host, use it. + (string (find-logical-host host t)) ; logical-host or lose. + (t default-host))) ; unix-host (diddle-args (and (eq (host-customary-case host) :lower) (eq case :common))) (diddle-defaults @@ -647,21 +675,12 @@ a host-structure or string." diddle-defaults)) (t nil)))) - (if (logical-host-p host) - (%make-logical-pathname - host - :unspecific - dir - (pick name namep %pathname-name) - (pick type typep %pathname-type) - ver) - (%make-pathname - host - dev - dir - (pick name namep %pathname-name) - (pick type typep %pathname-type) - ver))))) + (%make-pathname-object host + dev ; forced to :unspecific when logical-host + dir + (pick name namep %pathname-name) + (pick type typep %pathname-type) + ver)))) ;;; PATHNAME-HOST -- Interface ;;; @@ -784,10 +803,8 @@ a host-structure or string." does not match explicit host argument: ~S" host)) (let ((pn-host (or new-host parse-host))) - (values (funcall (if (typep pn-host 'logical-host) - #'%make-logical-pathname - #'%make-pathname) - pn-host device directory file type version) + (values (%make-pathname-object + pn-host device directory file type version) end)))))) @@ -1190,25 +1207,13 @@ a host-structure or string." (if (eq result :error) (error "~S doesn't match ~S" source from) result)))) - #+nil ;; pw- 1/3/97 This doesn't work. - (%make-pathname (or to-host source-host) - (frob %pathname-device) - (frob %pathname-directory translate-directories) - (frob %pathname-name) - (frob %pathname-type) - (frob %pathname-version)) - - (let ((host (or to-host source-host)) - (device (frob %pathname-device)) - (directory (frob %pathname-directory translate-directories)) - (name (frob %pathname-name)) - (type (frob %pathname-type)) - (version (frob %pathname-version))) - (if (logical-host-p host) - (%make-logical-pathname - host :unspecific directory name type version) - (%make-pathname - host device directory name type version))))))))) + (%make-pathname-object + (or to-host source-host) + (frob %pathname-device) + (frob %pathname-directory translate-directories) + (frob %pathname-name) + (frob %pathname-type) + (frob %pathname-version)))))))) ;;;; Search lists. diff --git a/code/pred.lisp b/code/pred.lisp index d4f086f41..9a2adaece 100644 --- a/code/pred.lisp +++ b/code/pred.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.35 1997/01/18 14:30:34 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.36 1997/02/05 16:15:58 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -26,7 +26,7 @@ (export '(typep null symbolp atom consp listp numberp integerp rationalp floatp complexp characterp stringp bit-vector-p vectorp simple-vector-p simple-string-p simple-bit-vector-p arrayp - functionp compiled-function-p commonp eq eql equal equalp not + functionp compiled-function-p eq eql equal equalp not type-of upgraded-array-element-type realp ;; Names of types... array atom bignum bit bit-vector character common diff --git a/code/save.lisp b/code/save.lisp index 778f22b0d..8b35c4f1e 100644 --- a/code/save.lisp +++ b/code/save.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.29 1997/01/18 14:30:54 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.30 1997/02/05 16:15:59 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -162,8 +162,6 @@ (reinit) (dolist (f *after-save-initializations*) (funcall f)) (environment-init) - (when site-init - (load site-init :if-does-not-exist nil :verbose nil)) (when process-command-line (ext::process-command-strings)) (setf *editor-lisp-p* nil) @@ -173,6 +171,8 @@ :test #'(lambda (x y) (declare (simple-string x y)) (string-equal x y))))) + (when site-init + (load site-init :if-does-not-exist nil :verbose nil)) (when (and process-command-line (find-switch "edit")) (setf *editor-lisp-p* t)) (when (and load-init-file -- GitLab