;;; -*- Mode:Lisp; Package:lambda; Base:8; readtable: ZL -*-
;defs file for diag-system.

;;;
;;; (c) Copyright 1984,1985,1986 - Lisp Machine, Inc.
;;;


(defmacro spy-write (adr data)
  (cond ((numberp adr)
	 `(cond ((access-path-lmi-serial-protocol *proc*)
		 (send *proc* ':prin1 ,data)
		 (send *proc* ':tyo-cr #/L)
		 (send *proc* ':prin1 ,(logand #o37 adr))
		 (send *proc* ':tyo-cr #/Y))
		(t
		 (send *proc* :bus-slot-write (send *proc* :rg-slot) ,(ash (logand #o37 adr) 2) ,data))))
	(t
	 `(cond ((access-path-lmi-serial-protocol *proc*)
		 (send *proc* ':prin1 data)
		 (send *proc* ':tyo-cr #/L)
		 (send *proc* ':prin1 (logand #o37 ,adr))
		 (send *proc* ':tyo-cr #/Y))
		(t
		 (send *proc* :bus-slot-write (send *proc* :rg-slot) (ash (logand #o37 ,adr) 2) ,data))))))

;mask specifies valid bits for comparision in SDU replay mode.

(defmacro spy-read (adr &optional mask)
  (cond ((numberp adr)
	 `(cond ((access-path-lmi-serial-protocol *proc*)
		 (send *proc* ':prin1 ,(logand #o37 adr))
		 (send *proc* ':tyo-cr #/X)
		 (send *proc* ':read-32 ,mask))
		(t
		 (send *proc* :bus-slot-read (send *proc* :rg-slot) ,(ash (logand #o37 adr) 2)))))
	(t
	 `(cond ((access-path-lmi-serial-protocol *proc*)
		 (send *proc* ':prin1 (logand #o37 ,adr))
		 (send *proc* ':tyo-cr #/X)
		 (send *proc* ':read-32 ,mask))
	       (t
		(send *proc* :bus-slot-read (send *proc* :rg-slot) (ash (logand #o37 ,adr) 2)))))))

(defflavor debuggable-processor
	   (prom-string
	    proc-type
	    tv-controller-type
	    tv-slot
	    tv-device-subindex	;for quad-video
	    disk-controller-type
	    disk-share-mode
	    disk-type
	    (proc-variables-to-switch nil)    ;plist of variables and values
	    (saved-opcs nil)
	    (saved-micro-stack nil)
	    memory-configuration-list ; (<size-of-memory-in-pages> <22.-bit-nubus-page-number>)
	    page-band-unit
	    )
	   ()
  (:method-combination (:case :base-flavor-last
			 :m-mem
			 :a-mem
			 :spy-reg))
  :settable-instance-variables)

(defflavor regint-lambda
	   (rg-slot
	    major-version
	    minor-version
	    proc-conf-pointer		;local lispm array. 
			;if dealing with remote processor, this is a copy of the real thing.
	    	        ;if dealing with local processor, this is the real thing.
	    proc-conf-bus-address)      ;base of real proc-conf for this processor, suitable for bus-read.
	   (debuggable-processor)
 (:initable-instance-variables rg-slot
			       major-version
			       minor-version
			       proc-conf-pointer
			       proc-conf-bus-address)
 (:gettable-instance-variables rg-slot
			       major-version
			       minor-version
			       proc-conf-pointer
			       proc-conf-bus-address)
 (:settable-instance-variables rg-slot)
  )


(defmethod (debuggable-processor :mem-slot) ()
  ;; this is for the old diag model of one-processor, one-memory board.
  ;; If you set up CONFIG right you can always arrange to allocate a whole
  ;; board to some processor and thereby win, especially if your purpose is
  ;; to run something like LAM-RUN-MTEST.
  (or (dolist (maybe-board memory-configuration-list)
	(let ((slot (ldb (byte 4 24.) (ash (cadr maybe-board) 10.)))
	      (offset-addr (ldb (byte 24. 0) (ash (cadr maybe-board) 10.))))
	  (when (zerop offset-addr)
	    ;; should make sure we have the whole board!
	    (return slot))))
      (ferror nil "Cant find a slot aligned memory board from ~S" (mapcar #'car memory-configuration-list))))
  

(defmethod (regint-lambda :slot) () rg-slot)

(defmethod (regint-lambda :set-prom-string-and-lambda-version) ()
  (setq prom-string (get-configuration-string-from-nubus rg-slot))
  (let ((versions (get-lambda-versions-from-config-string prom-string)))
    (setq major-version (car versions)
	  minor-version (cadr versions))))
	
(defflavor regint-explorer
	   ()
	   (debuggable-processor)
  )

(defmethod (regint-explorer :slot) () 0)	;is this right?

;All access-paths must have lmi-serial-protocol as an instance variable.
; furthermore, it must be the first one so the outside accessible thing works.
; This replaces all the old tests on *bus-communication-instance*.
(defflavor access-path ((lmi-serial-protocol nil)) ()
  (:ordered-instance-variables lmi-serial-protocol)
  (:outside-accessible-instance-variables lmi-serial-protocol)
  (:initable-instance-variables lmi-serial-protocol))

(defflavor local-access-path (safe-local-indexes)
	   (access-path))  ;on local bus, ie, 2x2 etc.

(defflavor debug-access-path ()		;debug board a la cadr.   nyi really.
	   (access-path))

(defflavor lmi-serial-access-path
	 (serial-stream baud serial-trace serial-last-direction unrchf)
	 (access-path)
  (:default-init-plist :lmi-serial-protocol t))

(defflavor ti-serial-access-path ()
	   (access-path))		;TI Explorer serial

(defflavor bus-coupler-access-path ()
	   (access-path))	;bus coupler used solely as debug card.

(defflavor nubus-via-explorer-processor ()
	   (access-path))

(defflavor nubus-via-burr-brown-and-nu-debug ()
	   (access-path))

;Various combinations of processor and access-path.  Note access-path must always come
; first.
(defflavor lambda-via-local-access
	   ()
	   (local-access-path regint-lambda))

(defflavor lambda-via-debug
	   ()
	   (debug-access-path regint-lambda))

(defflavor lambda-via-burr-brown
	   ()
	   (nubus-via-burr-brown-and-nu-debug
	    regint-lambda))

(defflavor lambda-via-lmi-serial
	 ()
	 (lmi-serial-access-path regint-lambda))

(defflavor explorer-via-ti-serial
	   ()
	   (nubus-via-explorer-processor
	    ti-serial-access-path
	    regint-explorer))

(defflavor explorer-via-ti-serial-with-nubus-from-burr-brown
	   ()
	   (nubus-via-burr-brown-and-nu-debug
	    ti-serial-access-path
	    regint-explorer))