;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: COMMON-LISP-USER; Base: 10. -*-

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                                                                          ;
;  COPYRIGHT (C) UNIVERSITY OF SOUTHERN CALIFORNIA, 1988, 1995             ; 
;  University of Southern California, Information Sciences Institute       ;
;  4676 Admiralty Way                                                      ;
;  Marina Del Rey, California 90292                                        ;
;                                                                          ;
;  This software was developed under the terms and conditions of Contract  ;
;  No. MDA903 81 C 0335 between the Defense Advanced Research Projects     ;
;  Agency and the University of Southern California, Information Sciences  ; 
;  Institute.  Use and distribution of this software is further subject    ;
;  to the provisions of that contract and any other agreements developed   ;
;  between the user of the software and the University of Southern         ;
;  California, Information Sciences Institute.  It is supplied "AS IS",    ;
;  without any warranties of any kind.  It is furnished only on the basis  ;
;  that any party who receives it indemnifies and holds harmless the       ;
;  parties who furnish and originate it against any claims, demands, or    ;
;  liabilities connected with using it, furnishing it to others or         ;
;  providing it to a third party.  THIS NOTICE MUST NOT BE REMOVED FROM    ;
;  THE SOFTWARE, AND IN THE EVENT THAT THE SOFTWARE IS DIVIDED, IT SHOULD  ;
;  BE ATTACHED TO EVERY PART.                                              ;
;                                                                          ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

;;; PATHNAMES.LISP ()

;;; Initialize pathname variables that point to the various subdirectories
;;;    and files referenced during the compilation and/or load process.


(in-package "COMMON-LISP-USER")

(defun loom-pathname (&key name (type *lisp-extension*) (defaults *loom-pathname-default*) subDirectory)
  ;; Returns a pathname for the specified file, merging in LOOM defaults.
  ;; "subDirectory" is a string naming a subdirectory of the loom root directory.

  ;; THE ":CASE" OPTION FOR "MAKE-PATHNAME" ISN'T IMPLEMENTED IN TI CL:
  #+(and :TI :ISI) (setf name (and name (string-upcase name))
			 subDirectory (and subDirectory (if (string= subDirectory "XLD")
							    (string-downcase subDirectory)
							    (string-upcase subDirectory)))
			 type (if (stringp type) (string-upcase type) type))
  (when (stringp subdirectory)
    (setq subdirectory (list subdirectory)))
  (let ((path (make-pathname 
		:name (truncate-name name)
		:type type
		:defaults defaults
		:directory (if subDirectory
			       #-(and :cmu (not :new-compiler))
			         (append (pathname-directory defaults) 
					 subdirectory)
			       #+(and :cmu (not :new-compiler))
			         (coerce
				  (append (coerce (pathname-directory defaults)
						  'LIST) 
					  subDirectory)
				  'SIMPLE-VECTOR)
				 (pathname-directory defaults)))))

    path ))

#+(or :allegro-v4.2 :allegro-v4.3)(pushnew :CLTL2 *features*)
;; insure that :CLOS feature is present if CLOS is:
#+:CLTL2
(pushnew :CLOS *features*)

;;; Create KBCLASSES and LOOM packages:
(load (loom-pathname :name "loom-package"))

;;; Define defsystem functions.  Load a compiled version if possible.
#+(and :TI (not :MK-DEFSYSTEM))
(load (loom-pathname :name "defsystem" :type :unspecific))
#+(and (or :LUCID :MCL) (not :MK-DEFSYSTEM))
(load (loom-pathname :name "defsystem" :type nil))
#-(or :MCL :LUCID :TI :MK-DEFSYSTEM)
(load (loom-pathname :name "defsystem"))
(load (loom-pathname :name "filename-extensions"))

(defun loom::load-loom-patches (&key (loom::compile-if-needed-p t)
                                     (loom::source-if-newer-p nil))
    "Loads the current set of patches for this Loom.
If `:source-if-newer-p' is T (default NIL), then source patches will be loaded
if they are newer than the binary.  If NIL, then only compiled patches will be
loaded.  If `:compile-if-needed-p' is T (default) then newer source patches
will be compiled before loading."
  (let* ((patchModule (find "patch" (make::component-components
				     (make::find-system 'loom))
			    :key #'make::component-name :test #'string-equal))
	 (patchFile (find "loom4-0-patches" (make::component-components
					  patchModule)
			    :key #'make::component-name :test #'string-equal))
	 (binaryFileName    (make::component-full-pathname patchFile :binary))
	 (sourceFileName    (make::component-full-pathname patchFile :source))
         (sourceExistsP (probe-file sourceFileName))
         (binaryExistsP (probe-file binaryFileName))
	 #+(or :Allegro-V4.1 :Allegro-V4.2 :Allegro-V4.3 :Allegro-v5.0)
	 (comp:*cltl1-compile-file-toplevel-compatibility-p* nil)
	 )

    (cl-user::with-redefinition-warnings-suppressed
      (cond ((and sourceExistsP binaryExistsP)
	     (if (< (file-write-date binaryFileName)
		    (file-write-date sourceFileName))
		 (cond (loom::compile-if-needed-p
			(cl-user::with-undefined-function-warnings-suppressed
			 (load (compile-file sourceFileName 
					     :output-file binaryFileName))))
		       (loom::source-if-newer-p
			(load sourceFileName))
		       (t (load binaryFileName)))
	       (load binaryFileName)))
	    (binaryExistsP
	     (load binaryFileName))
	    (sourceExistsP
	     (if loom::compile-if-needed-p
		 (cl-user::with-undefined-function-warnings-suppressed
		  (load (compile-file sourceFileName :output-file binaryFileName)))
	       (load sourceFileName)))
	    (t (warn "Couldn't find a binary or a source file for Loom patches~%~
                    Binary Filename = ~A~%Source Filename = ~A" 
		     binaryFileName sourceFileName)))) ))

(export 'loom::load-loom-patches "LOOM")


;;; Determine the directory for storing and retrieving binaries
;;; for this LISP:
(defvar *loom-binary-directory*;; load time determination
  (or #+(and :ISI :MCL)
      (translate-logical-pathname  "CCL:Research Loom binaries;")
      (loom-pathname
       :type #-TI nil #+TI :unspecific
       #+TI :name #+TI ""
       :subdirectory
       (list "BIN"
	     (or
	      #+(and (not :ISI) :MCL)
	      "MCL"
	      #+:LUCID
	      (let* ((HOST #+:PA "HP" #-:PA "")
		     (LISP (cond ((member :LCL4.2 user::*features*) "LCL4.2")
				 ((member :LCL4.1 user::*features*) "LCL4.1")
				 ((member :LCL4.0 user::*features*) "LCL4.0")
				 ("LCLx.x"))))
		(concatenate 'string HOST LISP))
	      #+:ALLEGRO
	      (let* ((HEAD #+(and :UNIX :SPARC) "ACL"
			   #+(and :UNIX :LINUX) "LXACL"
			   #+(and :UNIX (not :SPARC) (not :LINUX)) "HPACL"
			   #-:UNIX "ACL")
		     (VERSION (cond #+:excl((boundp 'excl::*common-lisp-version-number*)
					    excl::*common-lisp-version-number*)
				    (t "x.x"))))
		(concatenate 'string HEAD VERSION))
	      #+:TI "XLD"
	      #+:CMU "CMUCL"
	      "MISC")))) )

(load (loom-pathname :name "defsys"))
