LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031840. :SYSTEM-TYPE :LOGICAL :VERSION 10. :TYPE "LISP" :NAME "CANONICALIZE-COLD-LOAD-PATHNAMES" :DIRECTORY ("REL3-SOURCE" "PATHNAME") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758741636. :AUTHOR "REL3" :LENGTH-IN-BYTES 6265. :LENGTH-IN-BLOCKS 7. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ;; -*- Mode:COMMON-LISP; Package:FS; Base:10. -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;;; Copyright (C) 1985,1987 Texas Instruments Incorporated. All rights reserved.;;;  ** (c) Copyright 1980 Massachusetts Institute of Technology **;;; The sole purpose of CANONICALIZE-COLD-LOAD-PATHNAMES is to generate the ;;; the generic pathnames that weren't create properly during GENASYS.;;; Eventually the properties that are hung off of the generic pathname should;;; also be canonicalized, (some date strings and pathnames need it.);;; CANONICALIZE-AND-CLEANUP should be run once right after a cold built band ;;; is booted.  It runs the main canonicalizing function and then gets rid;;; of some intermediate kruft so it can be GCed.;;;;;;  This shouldn't be needed anymore... 11.15.86 MBC;;;;;;  Fix the hash table so :property fefs w/:source-file-name will work;;; (setf SI:FUNCTION-SPEC-HASH-TABLE (MAKE-HASH-TABLE :test 'equal :size 500));;;(defun CANONICALIZE-AND-CLEANUP ()  (declare (special *CANX-HASH-TABLE* SI:*COLD-LOADED-FILE-PROPERTY-LISTS*))  (fs:canonicalize-cold-load-pathnames t)  (setf SI:*COLD-LOADED-FILE-PROPERTY-LISTS* NIL FS:*CANX-HASH-TABLE* NIL));;; If pathname has been parsed already just return its object,;;; else parse it, stuff it in the table, and return it.(defun parse-with-host (pathname sys-sample)  (declare (special *CANX-HASH-TABLE*))  (let* ((key pathname) (pathname-object (GETHASH KEY *CANX-HASH-TABLE*)))    (cond (pathname-object)  (t (PUTHASH KEY (quick-parse key sys-sample) *CANX-HASH-TABLE*)))))(defvar  *CANX-HASH-TABLE* nil)(defun INIT-CANX-HASH ()  (SETQ *CANX-HASH-TABLE*(MAKE-HASH-TABLE :COMPARE-FUNCTION 'string-equal :HASH-FUNCTION 'SI::EQUAL-HASH :SIZE 500. :AREA default-cons-AREA)));expect 360. ??;;;(defsubst known-host-p (string)  (fs:parse-host (nsubstring  string 0 (position #\:  string)) t))(DEFUN CANONICALIZE-COLD-LOAD-PATHNAMES (&optional (Force-sys-host t))  "Run thru the humongous list, SI:*COLD-LOADED-FILE-PROPERTY-LISTS*, andcanonicalize all the source file names and their properties.  Finally, makeall symbols, methods, and :property functions have their :SOURCE-FILE-NAMEpoint at their canonicalized source pathname.  When Force-sys-host parse them all with SYS: Else allow pathnames to be physical when we know their host."  (declare (special SI:*COLD-LOADED-FILE-PROPERTY-LISTS*))  (unless (fboundp 'time:parse-universal-time)    (ferror nil "The function, TIME:PARSE-UNIVERSAL-TIME must be defined."))  (INIT-CANX-HASH)  (let ((sys-sample (SAMPLE-PATHNAME "SYS")))    (dolist (elem SI:*COLD-LOADED-FILE-PROPERTY-LISTS*)      (let ((pathname (parse-with-host (car elem) (and Force-sys-host sys-sample)))    (spkg (getf (cdr elem) :PACKAGE)))(DO ((L (CDR elem) (CDDR L)))    ((NULL L)     NIL)  (LET ((PROP (find-symbol (CAR L) si:pkg-keyword-package))(VAL (CADR L)))    (cond      ((EQ PROP :SOURCE-FILE-GENERIC-PATHNAME)       (when (stringp val) (setf val (fs:parse-pathname val))))      ((EQ PROP :QFASL-SOURCE-FILE-UNIQUE-ID)       (COND ((STRINGP VAL)  (setf val (fs:parse-pathname val))) ((typep val 'pathname)) (T (cerror t nil nil    "Can't handle :QFASL-SOURCE-FILE-UNIQUE-ID value, ~a on pathname, ~a."    val pathname))))            ((EQ PROP :FILE-ID-PACKAGE-ALIST)       (setf val (CANONICALIZE-FILE-ID-PACKAGE-ALIST val spkg)))      ((EQ PROP :DEFINITIONS)       (Replace-Source-File-Property pathname val sys-sample)))    (FUNCALL PATHNAME :PUTPROP VAL PROP)))))))(defun quick-parse (thing sample-pathname);change this to pass in sample pathname for more speed up!!  "Short cuts thru parse-pathname, and forces TYPE & VERSION to :UNSPECIFIC"  (MULTIPLE-VALUE-BIND (DEVICE DIRECTORY NAME ignore ignore ignore QUOTED-STRING)      (FUNCALL SAMPLE-PATHNAME ':PARSE-NAMESTRING       T THING (1+ (position #\:  thing)) (length thing))    (MAKE-PATHNAME-INTERNAL QUOTED-STRING (send SAMPLE-PATHNAME :host)    DEVICE DIRECTORY NAME :unspecific :unspecific)));should always be GENERIC(defun replace-source-file-property (pathname definitions sys-sample)  (dolist (el  (cdar definitions))    (let* ((function-spec (car el))   (f-type (cdr el))   (previous-source-file-definition     (si:FUNCTION-SPEC-GET function-spec :SOURCE-FILE-NAME)))            (if (consp  previous-source-file-definition)  (convert-source-file-definition previous-source-file-definition sys-sample)  (let ((SI:FDEFINE-FILE-PATHNAME  (cond ((stringp previous-source-file-definition) ;;;  Record it properly but, blast string first (setf (si:FUNCTION-SPEC-GET function-spec :SOURCE-FILE-NAME) nil) (parse-with-host previous-source-file-definition sys-sample))(t pathname))))    (declare (special SI:FDEFINE-FILE-PATHNAME))    (si:record-source-file-name function-spec f-type T))))))(defun convert-source-file-definition (previous-source-file-definition sys-sample)  (dolist (f-type-list previous-source-file-definition)    (dotimes (i (1- (length f-type-list)))      (let ((ind (1+ i)))(when (stringp (nth ind f-type-list))  (setf (nth ind f-type-list)(parse-with-host (nth ind f-type-list) sys-sample)))))))(defun CANONICALIZE-FILE-ID-PACKAGE-ALIST (alist file-package)  (when alist    (if (and file-package (null (caar alist)))(rplaca (car alist) (find-package      (if (eq file-package :GENASYS);Special Rel 3.0 kludge to catch  :COMPILER;one specific file, DEFOP.  file-package))))    (DOLIST (ID  (cdar ALIST))      (when (consp id)(if (STRINGP (cdr id))    (LET ((UT (time:parse-universal-time (cdr id))))      (IF UT (RPLACD id UT))))  (let ((pathname (car id)))  (if (stringp pathname)      (rplaca id      (fs:parse-pathname pathname))))))    alist))(DEFINE-CANONICAL-TYPE :MAC "MAC")  (DEFINE-CANONICAL-TYPE :TASM "TASM")  (DEFINE-CANONICAL-TYPE :DOC "DOC")  (DEFINE-CANONICAL-TYPE :MSS "MSS")  (DEFINE-CANONICAL-TYPE :TEX "TEX")(DEFINE-CANONICAL-TYPE :TEX-FORMAT "FMT")(DEFINE-CANONICAL-TYPE :TEX-FONT "TFM")(DEFINE-CANONICAL-TYPE :DVI "DVI")  (DEFINE-CANONICAL-TYPE :PL1 "PL1")  (DEFINE-CANONICAL-TYPE :CLU "CLU")  (DEFINE-CANONICAL-TYPE :C "C")(DEFINE-CANONICAL-TYPE :HEADER "HEADER"  ((:UNIX :UNIX-UCB) "H")  ((LMFS LISPM) "HEADER" "H"))(DEFINE-CANONICAL-TYPE :FORTRAN "FORTRAN"  ((:LMFS :LISPM) "FORTRAN" "FOR" "FTN" "F")  (:UNIX "F")  ((:VMS :MSDOS )"FOR")  (:UNIX-UCB "F" "FOR" "FTN" "FORTRAN"))(DEFINE-CANONICAL-TYPE :ASM "ASM"  ((:UNIX :UNIX-UCB) "S"))(DEFINE-CANONICAL-TYPE :OBJECT "OBJ"  ((:UNIX :UNIX-UCB) "O"))(DEFINE-CANONICAL-TYPE :YACC "YACC"  ((:VMS :UNIX :UNIX-UCB :MSDOS) "Y"))(DEFINE-CANON