;;; -*- Mode:LISP; Package:LAMBDA; Readtable:ZL; Base:10; Lowercase:T; Fonts:(CPTFONTB) -*-
;;;
;;; (c) Copyright 1986 - Lisp Machine, Inc.
;;;

;;; Youcef. 01/06/86.
;;;
;;;  This defines a diagnostic path object.
;;;

(defflavor diag-path
	   ((DEBUGGER-RACK nil)
	    (DEBUGGEE-RACK nil)
	    (INTERFACE nil)
	    (SLOT-NUMBER nil)
	    (MODE nil)
	    (MULTIBUS-ADDRESS NIL)
	    (CABLE nil)
	    (BOARD nil))
	   ()
  :gettable-instance-variables
  :settable-instance-variables
  :inittable-instance-variables
  )

;;;
;;; In the path object :
;;;                     DEBUGGER-RACK : rack object from which the diagnostics are run
;;;                     DEBUGGEE-RACK : rack object on which the diagnostics are run
;;;                     INTERFACE : type of connection between racks
;;;                     SLOT-NUMBER : slot where the debug hardware is residing.
;;;                     MODE : could be :LOCAL or :REMOTE
;;;                     BOARD : Board object being debugged.
;;;                     MULTIBUS-ADDRESS : multibus address used in the case of Burr Brown
;;;                     CABLE : length of cable if LMI-DEBUG board used and mode is :REMOTE
;;;

(defun get-configuration-of-other-bus (rack &aux item items)
  (funcall *proc* :interface-reset)
  (make-nubus-configuration-array)
  (dotimes (i (array-length nubus-configuration-array))
    (if (or (equal (setq item (first (aref nubus-configuration-array i))) 'EMPTY)
	    (equal (setq item (first (aref nubus-configuration-array i))) 'UNKNOWN))
	NIL
      (push `(,i (read-from-string (format nil ":~A" item))) items))
    )
  (funcall rack :set-list-of-slot-numbers-with-boards items)
  )

(defmethod (lambda-via-lmi-serial :interface-reset) (&rest ignore)
  )

(defmethod (diag-path :setup) ()
  ;; this is where we setup a structure for the rack to debug, the board
  ;; we are presently debugging and the setup of the environment.
  (setq tram-location-3000 nil)
  (setq lam-passive-save-valid nil)
  (setq lam-full-save-valid nil)
;  (setq mem-slot nil)
  (qf-clear-cache t)
  (qf-setup-q-fields t)
  (selectq INTERFACE
    (:LMI-DEBUG
     (setq *proc* *dummy-for-lmi-debug*)
     (selectq (first board)
       (LAMBDA
	(setup-nubus-configuration)
;	(set-configuration-pointer)
	(lambda-mode)
	(setq *all-procs*
	      (list (setq *proc*
			  (make-instance 'lambda-via-lmi-debug
					 :slot-number slot-number
					 :rg-slot (second board)
					 :disk-controller-type nil
					 :disk-type 'eagle
					 :disk-share-mode t
					 :proc-type :lambda
					 :memory-configuration-list nil
					 :major-version lambda-major-version-number
					 :minor-version lambda-minor-version-number
					 :proc-conf-pointer
					 (make-array (* 2 page-size) :type :art-16b)
					 :tv-slot 0)))
	      debug-slot (dpb #xf (byte 4 4) slot-number))
;	  (set-all-procs-from-remote-conf)
	  )
       (MC68000 )
       (EXPLORER )
       ))
    (:BURR-BROWN
     (setq *proc* *dummy-for-burr-brown*)
     (setq bb-address multibus-address)
     (selectq (first board)
       (LAMBDA
	(setup-nubus-configuration)
	(set-configuration-pointer)
	(lambda-mode)
	(if (null *configuration-pointer*)
	    (setq *all-procs*
		  (list (setq *proc*
			      (make-instance 'lambda-via-burr-brown
					     :rg-slot (second board)
					     :disk-controller-type nil
					     :disk-type 'eagle
					     :disk-share-mode t
					     :proc-type :lambda
					     :memory-configuration-list nil
					     :major-version lambda-major-version-number
					     :minor-version lambda-minor-version-number
					     :proc-conf-pointer
					     (make-array (* 2 page-size) :type :art-16b)
					     :tv-slot 0))))
	  (set-all-procs-from-remote-conf))
	)
       (EXPLORER
	(explorer-mode)
	(si:new-set-up-serial-b-interrupts)
	(setq *proc* (make-instance 'explorer-via-ti-serial-with-numbus-from-burr-brown
				    :proc-type :EXPLORER
				    :MEMORY-CONFIGURATION-LIST
				    `((4000 ,(ash #xf4000000 -10.))
				     (4000 ,(ash #xf3000000 -10.)))))
	(exp-serial-setup))
       (MC68000
	;; not yet but soon
	)))
    (:SERIAL
     (selectq (first board)
       (LAMBDA
	(funcall *dummy-for-serial* :setup-nubus-configuration-and-configuration-pointer)
	(set-all-procs-list-from-serial-conf)
	 )
       (EXPLORER
	(explorer-mode)
	(si:new-set-up-serial-b-interrupts)
	(setq *proc* (make-instance 'explorer-via-ti-serial-with-numbus-from-burr-brown
				    :proc-type :EXPLORER
				    :MEMORY-CONFIGURATION-LIST
				    `((4000 ,(ash #xf4000000 -10.))
				     (4000 ,(ash #xf3000000 -10.)))))
	(exp-serial-setup))
       (MC68000
	;; not now but soon
	)))
    (:LOCAL
     (selectq (first board)
       (LAMBDA
	(set-all-procs-list-from-local-conf))
       (EXPLORER
	(explorer-mode)
	(si:new-set-up-serial-b-interrupts)
	(setq *proc* (make-instance 'explorer-via-ti-serial-with-numbus-from-burr-brown
				    :proc-type :EXPLORER
				    :MEMORY-CONFIGURATION-LIST
				    `((4000 ,(ash #xf4000000 -10.))
				     (4000 ,(ash #xf3000000 -10.)))))
	(exp-serial-setup))
       (MC68000))))
  ;; this part should be somewhere else.
;  (setq *proc* NIL)
;  (select-processor-for-debugging) ;was SELECT-PROCESSOR,renamed to avoid system symbol
;  (SELECT-PROCESSOR
;  (selectq interface
;    (:BURR-BROWN
;     (selectq (first board)
;       (LAMBDA
;	(setup-for-disk))
;       (EXPLORER)))
;    (:LOCAL))
  (setq izero-good-parity (compute-parity-64 0))
  (new-select-test)
  )

;(DEFFLAVOR board-type
;	   ((type nil)				; could be :LAMBDA, :AVP, :MEMORY, ...
;	    (slot-number)			; nubus slot number.
;	    )
;	   ()
;  :gettable-instance-variables
;  :settable-instance-variables
;  :inittable-instance-variables
;  )