;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 130.12
;;; Reason:
;;;  The :SOURCE-PATHNAME operation on a generic pathname will no longer
;;;  return completely unreasonable answers such as FDEF.  As it is impossible
;;;  to make the pathname system work correctly, this is implemented by a simple
;;;  *KNOWN-NON-SOURCE-FILE-TYPES* list of unacceptable results, for which :LISP
;;;  is unconditionally substituted.
;;; Written 23-Nov-88 12:01:23 by smh at site Gigamos Cambridge
;;; while running on Harpo from band 1
;;; with Experimental System 130.11, Experimental ZWEI 128.8, Experimental ZMail 75.0, Experimental Local-File 77.0, Experimental File-Server 26.0, Experimental Unix-Interface 16.0, Experimental Tape 27.0, Experimental Lambda-Diag 19.0, Microcode 1762, SDU Boot Tape 3.14, SDU ROM 102, 11/18 Falcon System Loaded.



; From modified file DJ: L.IO.FILE; PATHNM.LISP#577 at 23-Nov-88 12:01:54
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; PATHNM  "

(defvar *known-non-source-file-types*
	'(:QFASL :FBIN :FDEF :UNSPECIFIED
		 :PRESS :WIDTHS :KST :IMPRESS :DVI :FASL :MCR :QBIN :EXE :BIN)
  "A list of canonical types which should never be considered source file types,
no matter how confused the pathname system becomes.  These types are always
replaced by :LISP inside GENERIC-PATHNAME-SOURCE-PATHNAME.")

))

; From modified file DJ: L.IO.FILE; PATHNM.LISP#577 at 23-Nov-88 12:03:34
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; PATHNM  "

(DEFUN GENERIC-PATHNAME-SOURCE-PATHNAME (PATHNAME)
  "Given the generic pathname PATHNAME, return a pathname for the source file.
We use the actual source file name as recorded, if possible."
  (LET ((QFASL-SOURCE (SEND PATHNAME :GET :QFASL-SOURCE-FILE-UNIQUE-ID))
	(LOADED-FILE (CAADAR (SEND PATHNAME :GET :FILE-ID-PACKAGE-ALIST))))
    (MULTIPLE-VALUE-BIND (CTYPE OTYPE)
	(COND (QFASL-SOURCE
	       (IF (CONSP QFASL-SOURCE)		;dont bomb if list frobs somehow 
		   ;left from cold load.
		   (SETQ QFASL-SOURCE
			 (PATHNAME-FROM-COLD-LOAD-PATHLIST QFASL-SOURCE)))
	       (SEND QFASL-SOURCE :CANONICAL-TYPE))
	      ((AND LOADED-FILE
		    (NOT (EQUAL (SEND LOADED-FILE :TYPE) "QFASL")))
	       (SEND LOADED-FILE :CANONICAL-TYPE))
	      (T (SEND (SEND PATHNAME :HOST) :GENERIC-SOURCE-TYPE
		       (SEND PATHNAME :CANONICAL-TYPE))))
      (SEND PATHNAME :NEW-PATHNAME :VERSION :NEWEST
	    ;; The replacement of :UNSPECIFIC by :LISP
	    ;; is for files that were last compiled on ITS or FC.
	    ;; $$$ Replaced by a list of unacceptable answers to keep developers
	    ;; from going mad.  The pathname system should be diked out with rusty
	    ;; pinking shears. <23-Nov-88 smh>
	    :CANONICAL-TYPE (IF (memq CTYPE *known-non-source-file-types*)
				:LISP CTYPE)
	    :ORIGINAL-TYPE OTYPE))))

))