;;; -*- Mode: Common-Lisp; Package: User; Base: 8.; Patch-File: T -*-

;;; Reason: Allow an mmon-p disk-saved band to boot on a different hardware configuration. [SPR 10196]

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to
;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;; Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;   TEXAS INSTRUMENTS INCORPORATED      
;;;   P.O. BOX 2909, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Patch file for SYSTEM version 6.22
;;; Written 10/20/89 12:08:22 by marky,
;;; while running on LIBRA from band LODA
;;; With SYSTEM 6.20, VIRTUAL-MEMORY 6.2, EH 6.5, MAKE-SYSTEM 6.2, MICRONET 6.0, LOCAL-FILE 6.1,
;;;  BASIC-PATHNAME 6.2, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.4, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.1, DISK-LABEL 6.0, BASIC-FILE 6.4, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.12, TV 6.15, DATALINK 6.0, CHAOSNET 6.1, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.2,
;;;  SYSLOG 6.2, STREAMER-TAPE 6.4, UCL 6.0, INPUT-EDITOR 6.0, METER 6.1, ZWEI 6.7,
;;;  DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.1, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.3, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.2,
;;;  IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.3, MAIL-READER 6.5, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.3, PROFILE 6.2, VISIDOC 6.5, TI-CLOS 6.25, CLEH 6.5, IP 3.54,
;;;  Experimental CLX 6.5, CLUE 6.25, X11M 6.15, Experimental BUG 11.15, Inconsistent MMON 6.1,
;;;   microcode 429, Band Name: clogged

;;; SPR 10196 part of series of patches : window.6.17 ,mmon.6.2
;;; Call tv:init-csib-registers BEFORE (si:process-initialize) starts up from
;;; the si:system-initialization-list and causes the blinkers, etc to do a
;;; tv:sheet-load-registers and allow (:method tv:block-flavor :set-foreground-color-register)
;;; to succeed when the mmon disk-saved band is moved to a different hardware config.
;;; 

#!C
; From file WINDOW-INITS.LISP#> KERNEL; Hotel:
#8R SYSTEM#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* *COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: KERNEL; WINDOW-INITS.#"


(DEFUN setup-sib-slots ()
  ;; may 10/17/89 
  (declare (special tv:*color-system*)) ;; historical garbage var loaded later in sys:window;tvdefs
  ;; find all SIBs/CSIBs and put in TV:*SIB-SLOTS* and TV:*CSIB-SLOTS*.
  ;; includes primary sib, tv:sib-slot-number in list.
  (SETQ tv:*csib-slots* nil)
  (SETQ tv:*sib-slots* nil)
  (SETQ tv:*aux-csib-fslots* nil) ;; may 01/27/89 
  (DO ((slots-i-own (get-paging-parameter %Slots-I-Own))
       (bit-index 0 (1+ bit-index)))
      ((= bit-index 16.))
    ;; Make sure we own the board
    (WHEN (LDB-TEST (BYTE 1 bit-index) slots-i-own)
      (LET ((slot (DPB bit-index (BYTE 4. 0.) #xf0)))
	(COND ((STRING= "SIB" (board-type slot))
	       (SETQ tv:*sib-slots* (CONS bit-index tv:*sib-slots*)))
	      ((STRING= "CSI" (board-type slot))
	       (SETQ tv:*csib-slots* (CONS bit-index tv:*csib-slots*)))))))
  ;; Set *csib-slot* to the primary CSIB.  07/27/88 KJF.
  ;; It used to get set by tv:init-csib-registers and :before :init of tv:control-register-flavor.
  (SETQ tv:*csib-slot* (AND tv:sib-is-csib (- tv:sib-slot-number #xf0)))
  (dolist (slot tv:*csib-slots* tv:*aux-csib-fslots*)
    (when (neq (ldb #o4 slot) (ldb #o4 tv:sib-slot-number))
      (setq tv:*aux-csib-fslots* (cons (dpb slot #o4 #x+F0) tv:*aux-csib-fslots*))))
  
  ;; may 10/17/89 Moved forms below from (tv:window-initialize) since we need to do this 
  ;; before calling tv:init-csib-registers

  ;; Don't allow *COLOR-SYSTEM* when we don't have a CSIB.  CJJ 04/13/88
  (UNLESS tv:sib-is-csib
    (SETF tv:*color-system* nil))
  (IF tv:*csib-slots*
      (PROGN
	(SETF time:keyboard-base #xf30000
	      time:configuration-rom-base #xff0000)
	(AND (fboundp 'tv:init-csib-registers)  ;; not in cold band, but we don't build on color systems
	     (tv:init-csib-registers))) ;;; one time initialization of csib control registers
      (SETF time:keyboard-base #xfc0000
	    time:configuration-rom-base #xfe0000))
  )
))