;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.240
;;; Reason:
;;;  (si:define-host) did an inadequate job of determining if it was redefining
;;;  an existing host.  It successfully detected the case where the main name
;;;  of the host was a nickname of an existing host, but didn't let you change
;;;  the main name and retain the former name as a nickname....
;;; Written 25-Apr-88 17:03:33 by pld at site Gigamos Cambridge
;;; while running on Cthulhu from band 1
;;; with Experimental System 123.239, Experimental Local-File 73.4, Experimental FILE-Server 22.2, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Tape 22.1, microcode 1755, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From modified file DJ: L.NETWORK; HOST.LISP#157 at 25-Apr-88 17:03:34
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "DJ: L.NETWORK; HOST.#"

(DEFUN DEFINE-HOST (NAME &REST OPTIONS)
  "Define a host.  Should be used only in SYS:SITE;HSTTBL LISP."
  (let (name-list system-type-internal machine-type-internal addresses elem old-p)
    (loop for (option value) on options by 'cddr
	  do (case option
	       (:host-names (setq name-list value))
	       (:system-type (setq system-type-internal value))
	       (:machine-type (setq machine-type-internal value))
	       (otherwise (setq addresses (append (list option value) addresses)))))
    (setq elem (or (block found
		     (dolist (host host-alist)
		       (dolist (name name-list)
			 (when (member-equalp name (host-name-list host))
			   (setq old-p t)
			   (return-from found host)))))
		   (make-host-alist-elem)))
    (setf (host-name elem) name)
    (setf (host-name-list elem) name-list)
    (setf (host-system-type-internal elem) system-type-internal)
    (setf (host-machine-type-internal elem) machine-type-internal)
    (setf (host-addresses elem) addresses)
    (cond ((consp (host-site-name elem))	;Site is a list -- add this site to list
	   (pushnew site-name (host-site-name elem)))
	  ((null (host-site-name elem))		;Site is unspecified -- set it to this site
	   (setf (host-site-name elem) site-name))
	  ((neq (host-site-name elem) site-name);Site is specified but different -- create list
	   (setf (host-site-name elem) (list site-name (host-site-name elem)))))
    (IF (NOT OLD-P)
	(PUSH ELEM HOST-ALIST)
      ;; It changed flavors, due to network or OS change.  Just ignore it for now.
      (LET ((OLD-INSTANCE (HOST-INSTANCE ELEM)))
	(WHEN OLD-INSTANCE
	  (LET ((FLAVOR (COMPUTE-HOST-FLAVOR ELEM)))
	    (WHEN (NEQ FLAVOR (TYPE-OF OLD-INSTANCE))
	      (FORMAT *ERROR-OUTPUT* "~&[Sorry, can't change ~A's flavor.]~%" (HOST-NAME ELEM))
	      ;;Invalidate host. (Thats nasty. -gjc)
	      (SETF (HOST-ADDRESSES ELEM) NIL)))
	  ;; needed because this may depend on :special-file-hosts which may change.
	  (SEND OLD-INSTANCE :SEND-IF-HANDLES :RESET-SAMPLE-PATHNAME))))))

))