;;; -*- Mode:LISP; Package:LAMBDA; Base:8; Readtable:ZL -*-


;;; Copyright LISP Machine, Inc. 1986
;;;   See filename "Copyright.Text" for		
;;; licensing and release information.


;defflavor for regint-explorer moved to diag-system

(defvar *ibufs-setup* nil)	;kludgy buffers in 990 frob set.

;(defun setup-*proc*-all-serial ()
;  (setq *proc* (make-instance 'explorer-via-ti-serial
;			      :proc-type :explorer
;			      :memory-configuration-list
;			          `((4000 ,(ash #xf4000000 -10.))
;				    (4000 ,(ash #xf3000000 -10.))))))
;(defun setup-*proc* ()
;  (setq *proc* (make-instance 'explorer-via-ti-serial-with-nubus-from-burr-brown
;			      :proc-type :explorer
;			      :memory-configuration-list
;			      `((4000 ,(ash #xf4000000 -10.)) (4000 ,(ash #xf3000000 -10.))))))
  

(defmethod (regint-explorer :bus-quad-slot-read) (quad-slot byte-adr)
  (rav-phys-read (dpb quad-slot (byte 8 24.) byte-adr)))

(defmethod (regint-explorer :bus-quad-slot-write) (quad-slot byte-adr data)
  (rav-phys-write (dpb quad-slot (byte 8 24.) byte-adr) data))

(defmethod (regint-explorer :reset) ()
  (setq *ibus-setup* nil)
  nil)

;also works to give adr with func-src indicator
(defmethod (regint-explorer :read-m-mem) (adr)
  (raven-execute (read)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-setm
    rav-ir-m-src adr)
  (spi-read-obus)
  )

(defmethod (regint-explorer :write-m-mem) (adr data)
  (spi-write-md data)
  (raven-execute (write)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-setm
    rav-ir-m-src rav-m-src-md
    rav-ir-m-mem-dest adr))

(defmethod (regint-explorer :read-a-mem) (adr)
  (raven-execute (read)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-seta
    rav-ir-a-src adr)
  (spi-read-obus))

(defmethod (regint-explorer :write-a-mem) (adr data)
  (spi-write-md data)
  (raven-execute (write)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-setm
    rav-ir-m-src rav-m-src-md
    rav-ir-a-mem-dest-flag 1
    rav-ir-a-mem-dest adr))

(defmethod (regint-explorer :read-c-mem) (adr)
  (send self :write-pc-to-hardware adr)
  (spi-read-ir)
  )

(defmethod (regint-explorer :write-c-mem) (adr data)
  (send self :write-pc-to-hardware adr)
  (spi-write-cram data))

(defmethod (regint-explorer :read-d-mem) (adr)
  (send self :save-dc-and-q)
  (raven-execute (write)
    rav-ir-op rav-op-dispatch
    rav-ir-dispatch-addr adr
    rav-ir-read-dispatch-memory 1)
  (rav-read-func-src rav-m-src-q)
  )

(defvar lam-saved-q nil)
(defvar lam-saved-dc nil)

(defmethod (regint-explorer :save-dc-and-q) ()
  (if (null lam-saved-q)
      (setq lam-saved-q (rav-read-func-src rav-m-src-q)))
  (if (null lam-saved-dc)
      (setq lam-saved-dc (rav-read-func-src rav-m-src-disp-constant))))

(defmethod (regint-explorer :write-d-mem) (adr data)
  (spi-write-md data)
  (raven-execute (write)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-setm
    rav-ir-m-mem-dest 0
    rav-ir-m-src rav-m-src-md)
  (raven-execute (write)
    rav-ir-op rav-op-dispatch
    rav-ir-dispatch-addr adr
    rav-ir-write-dispatch-memory 1
    rav-ir-a-src 0
    )
  )

(defmethod (regint-explorer :read-q-reg) ()
  (send self :save-dc-and-q)
  lam-saved-q)

(defmethod (regint-explorer :read-q-reg-from-hardware) ()
  (rav-read-func-src rav-m-src-q))

(defmethod (regint-explorer :write-q-reg) (data)
  (send self :save-dc-and-q)
  (setq lam-saved-q data))

(defmethod (regint-explorer :write-q-reg-to-hardware) (data)
  (spi-write-md data)
  (raven-execute (write)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-setm
    rav-ir-m-src rav-m-src-md
    rav-ir-q rav-q-load
    ))

(defmethod (regint-explorer :read-md) ()
  lam-saved-md)

(defmethod (regint-explorer :read-md-from-hardware) ()
  (rav-read-func-src rav-m-src-md))

(defmethod (regint-explorer :write-md) (data)
  (setq lam-saved-md data))

(defmethod (regint-explorer :write-md-to-hardware) (data)
  (spi-write-md data))

(defmethod (regint-explorer :read-vma) ()
  lam-saved-vma)

(defmethod (regint-explorer :read-vma-from-hardware) ()
  (rav-read-func-src rav-m-src-vma))

(defmethod (regint-explorer :write-vma) (data)
  (setq lam-vma-changed-flag t)
  (setq lam-saved-vma data))

(defmethod (regint-explorer :write-vma-to-hardware) (data)
  (rav-write-func-dest rav-func-dest-vma data))

(defmethod (regint-explorer :read-pdl-buffer) (adr)
  (lam-save-pdl-buffer-index)
  (rav-write-func-dest rav-func-dest-pdl-buffer-index adr)
  (rav-read-func-src rav-m-src-c-pdl-buffer-index))

(defmethod (regint-explorer :write-pdl-buffer) (adr data)
  (if (null lam-saved-pdl-buffer-index)
      (lam-save-pdl-buffer-index))
  (rav-write-func-dest rav-func-dest-pdl-buffer-index adr)
  (rav-write-func-dest rav-func-dest-c-pdl-buffer-index data))

(defmethod (regint-explorer :read-pi) ()
  (or lam-saved-pdl-buffer-index
      (setq lam-saved-pdl-buffer-index (rav-read-func-src rav-m-src-pdl-buffer-index))))

(defmethod (regint-explorer :read-pi-from-hardware) ()
  (rav-read-func-src rav-m-src-pdl-buffer-index))

(defmethod (regint-explorer :write-pi) (data)
  (setq lam-saved-pdl-buffer-index data))

(defmethod (regint-explorer :write-pi-to-hardware) (data)
  (rav-write-func-dest rav-func-dest-pdl-buffer-index data))

(defmethod (regint-explorer :read-pp) ()
  (rav-read-func-src rav-m-src-pdl-buffer-pointer))

(defmethod (regint-explorer :write-pp) (data)
  (rav-write-func-dest rav-func-dest-pdl-buffer-pointer data))

(defmethod (regint-explorer :read-pc) ()
  lam-saved-pc)

(defmethod (regint-explorer :read-pc-from-hardware) ()
  (spi-read-pc))

(defmethod (regint-explorer :write-pc) (adr &optional (n-bit 1))
  (setq lam-saved-pc adr)
  (if (zerop n-bit)
      (setq lam-noop-flag nil)
    (setq lam-noop-flag t)))

(defmethod (regint-explorer :write-pc-to-hardware) (adr &optional (n-bit 1))
  (raven-execute (read)
    rav-ir-op rav-op-jump
    rav-ir-jump-cond rav-jump-cond-unc
    rav-ir-jump-addr adr
    rav-ir-n n-bit)
  (spi-single-step)
  )

(defmethod (regint-explorer :read-l1-map) (adr)
  (cond ((and lam-saved-level-1-map-loc-0
	      (zerop adr))
	 lam-saved-level-1-map-loc-0)
	(t
	 (spi-write-md (dpb adr (byte 12. 13.) 0))
	 (rav-read-func-src rav-m-src-l1-map))))

(defmethod (regint-explorer :save-l1-map-0) ()
  (unless lam-saved-level-1-map-loc-0
    (spi-write-md 0)
    (setq lam-saved-level-1-map-loc-0 (rav-read-func-src rav-m-src-l1-map))))

(defmethod (regint-explorer :write-l1-map) (adr data)
  (lam-save-level-1-map-loc-0)
  (cond ((zerop adr)
	 (setq lam-saved-level-1-map-loc-0 data))
	(t
	 (rav-write-func-dest rav-func-dest-vma data)
	 (spi-write-md (dpb adr (byte 12. 13.) 0))
	 (raven-execute (write)
	   rav-ir-op rav-op-alu
	   rav-ir-ob rav-ob-alu
	   rav-ir-aluf rav-alu-setm
	   rav-ir-m-src rav-m-src-vma
	   rav-ir-func-dest rav-func-dest-vma-write-l1))))

(defmethod (regint-explorer :write-l1-map-to-hardware) (adr data)
  (rav-write-func-dest rav-func-dest-vma data)
  (spi-write-md (dpb adr (byte 12. 13.) 0))
  (raven-execute (write)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-setm
    rav-ir-m-src rav-m-src-vma
    rav-ir-func-dest rav-func-dest-vma-write-l1))

(defmethod (regint-explorer :read-l2-map-control) (adr)
  (lam-save-level-1-map-loc-0)
  (rav-write-func-dest rav-func-dest-vma (ldb (byte 7 5) adr))
  (spi-write-md 0)
  (raven-execute (write)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-setm
    rav-ir-m-src rav-m-src-vma
    rav-ir-func-dest rav-func-dest-vma-write-l1)
  (spi-write-md (dpb adr (byte 5 8) 0))
  (rav-read-func-src rav-m-src-l2-map-control))

(defmethod (regint-explorer :write-l2-map-control) (adr data)
  (lam-save-level-1-map-loc-0)
  (rav-write-func-dest rav-func-dest-vma (ldb (byte 7 5) adr))
  (spi-write-md 0)
  (raven-execute (write)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-setm
    rav-ir-m-src rav-m-src-vma
    rav-ir-func-dest rav-func-dest-vma-write-l1)
  (rav-write-func-dest rav-func-dest-vma data)
  (spi-write-md (dpb adr (byte 5 8) 0))
  (raven-execute (write)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-setm
    rav-ir-m-src rav-m-src-vma
    rav-ir-func-dest rav-func-dest-vma-write-l2-map-control))

(defmethod (regint-explorer :read-l2-map-physical-page) (adr)
  (lam-save-level-1-map-loc-0)
  (rav-write-func-dest rav-func-dest-vma (ldb (byte 7 5) adr))
  (spi-write-md 0)
  (raven-execute (write)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-setm
    rav-ir-m-src rav-m-src-vma
    rav-ir-func-dest rav-func-dest-vma-write-l1)
  (spi-write-md (dpb adr (byte 5 8) 0))
  (rav-read-func-src rav-m-src-l2-map-physical-page))



(defmethod (regint-explorer :write-l2-map-physical-page) (adr data)
  (lam-save-level-1-map-loc-0)
  (rav-write-func-dest rav-func-dest-vma (ldb (byte 7 5) adr))
  (spi-write-md 0)
  (raven-execute (write)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-setm
    rav-ir-m-src rav-m-src-vma
    rav-ir-func-dest rav-func-dest-vma-write-l1)
  (rav-write-func-dest rav-func-dest-vma data)
  (spi-write-md (dpb adr (byte 5 8) 0))
  (raven-execute (write)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-setm
    rav-ir-m-src rav-m-src-vma
    rav-ir-func-dest rav-func-dest-vma-write-l2-map-physical-page))


(defmethod (regint-explorer :read-usp) ()
  (or lam-saved-micro-stack-ptr
      (setq lam-saved-micro-stack-ptr
	    (rav-read-func-src rav-m-src-micro-stack-pointer))))

(defmethod (regint-explorer :read-usp-from-hardware) ()
  (rav-read-func-src rav-m-src-micro-stack-pointer))

(defmethod (regint-explorer :write-usp) (data)
  (setq lam-saved-micro-stack-ptr data))

(defmethod (regint-explorer :write-usp-to-hardware) (data)
  (rav-write-func-dest rav-func-dest-micro-stack-pointer data))

(defmethod (regint-explorer :read-us) (adr)
  (LAM-SAVE-MICRO-STACK-PTR)
  (rav-write-func-dest rav-func-dest-micro-stack-pointer adr)
  (rav-read-func-src rav-m-src-micro-stack-data)
  )

(defmethod (regint-explorer :write-us) (adr data)
  (LAM-SAVE-MICRO-STACK-PTR)
  (rav-write-func-dest rav-func-dest-micro-stack-pointer adr)
  (rav-write-func-dest rav-func-dest-micro-stack-data data))

(defmethod (regint-explorer :read-lc) ()
  (rav-read-func-src rav-m-src-lc))

(defmethod (regint-explorer :write-lc) (data)
  (rav-write-func-dest rav-func-dest-lc data))

(defmethod (regint-explorer :read-macro-ir) ()
  (rav-read-func-src rav-m-src-macro.ir))

(defmethod (regint-explorer :write-macro-ir) (data)
  (rav-write-func-dest rav-func-dest-macro.ir data))

(defmethod (regint-explorer :read-mcr) ()
  (rav-read-func-src rav-m-src-mcr))

(defmethod (regint-explorer :write-mcr) (data)
  (rav-write-func-dest rav-func-dest-mcr data))

(defun rav-abort-and-parity-off ()
  (let ((old (send *proc* :read-mcr)))
    (send *proc* :write-mcr (dpb 0 (byte 1 13.)
				 (dpb 0 (byte 1 12.)
				      old))))
  )

(defun rav-nubus-reset ()
  (send *proc* :write-mcr (dpb 1 (byte 1 21.) (send *proc* :read-mcr)))
  (send *proc* :write-mcr (dpb 0 (byte 1 21.) (send *proc* :read-mcr))))


(defun print-mcr-data (data)
  (format t "~&~o" data)
  (format t "~&LED ~s" (ldb (byte 6 0) data))
  (format t "~&Self test passed ~s" (ldb (byte 1 6) data))
  (format t "~&Subsystem test passed ~s" (ldb (byte 1 7) data))
  (format t "~&Memory cycle enable ~s" (ldb (byte 1 8) data))
  (format t "~&Forced access request ~s" (ldb (byte 1 9) data))
  (format t "~&Bus lock ~s" (ldb (byte 1 10.) data))
  (format t "~&PROM disable ~s" (ldb (byte 1 11.) data))
  (format t "~&Halt on parity error ~s" (ldb (byte 1 12.) data))
  (format t "~&Abort on bus error ~s" (ldb (byte 1 13.) data))
  (format t "~&Sequence break request ~s" (ldb (byte 1 14.) data))
  (format t "~&Interrupt enable ~s" (ldb (byte 1 15.) data))
  (format t "~&Interrupt level ~s" (ldb (byte 4 16.) data))
  (format t "~&Power fail and warm boot enable ~s" (ldb (byte 1 20.) data))
  (format t "~&Nubus reset ~s" (ldb (byte 1 21.) data))
  (format t "~&Need fetch ~s" (ldb (byte 1 22.) data))
  (format t "~&Loop on self test ~s" (ldb (byte 1 23.) data))
  (format t "~&Enable MISC0 ~s" (ldb (byte 1 24.) data))
  (format t "~&Enable MISC1 ~s" (ldb (byte 1 25.) data))
  (format t "~&Macro-inst chaining enable ~s" (ldb (byte 1 26.) data))
  (format t "~&Self test busy ~s" (ldb (byte 1 27.) data))
  (format t "~&Nubus slot ~s" (ldb (byte 4 28.) data)))

(defun print-mcr ()
  (print-mcr-data (send *proc* :read-mcr)))

(defun initialize-mcr ()
  (send *proc* :write-mcr (+ (dpb 1 (byte 1 8) 0) ;memory cycle enable
			     (dpb 1 (byte 1 11.) 0) ;prom disable
			     )))


(defun check-md ()
  (send *proc* :write-md-to-hardware 123)
  (cond ((not (= (send *proc* :read-md-from-hardware) 123))
	 (ferror nil "foo")))
  (send *proc* :write-md-to-hardware 321)
  (cond ((not (= (send *proc* :read-md-from-hardware) 321))
	 (ferror nil "foo"))))

(defmethod (regint-explorer :read-stat-counter) ()
  0)

(defmethod (regint-explorer :write-stat-counter) (data)
  data)

(defmethod (regint-explorer :read-aux-stat-counter) ()
  0)

(defmethod (regint-explorer :write-aux-stat-counter) (data)
  data)

(defmethod (regint-explorer :read-dc) ()
  (send self :save-dc-and-q)
  lam-saved-dc)

(defmethod (regint-explorer :read-dc-from-hardware) ()
  (rav-read-func-src rav-m-src-q))

(defmethod (regint-explorer :write-dc) (data)
  (send self :save-dc-and-q)
  (setq lam-saved-dc data))

;clobbers Q
(defmethod (regint-explorer :write-dc-to-hardware) (data)
  (raven-execute (write)
    rav-ir-op rav-op-dispatch
    rav-ir-disp-const data
    rav-ir-read-dispatch-memory 1))

(defmethod (regint-explorer :read-mid) (adr)
  adr
  0)

(defmethod (regint-explorer :write-mid) (adr data)
  adr data)

(defmethod (regint-explorer :read-cam) (adr)
  adr
  0)

(defmethod (regint-explorer :write-cam) (adr data)
  adr data)

(defmethod (regint-explorer :read-ireg) ()
  lam-saved-ir)

(defmethod (regint-explorer :read-ireg-from-hardware) ()
  (spi-read-ir))

(defmethod (regint-explorer :write-ireg) (data)
  (setq lam-saved-ir data))

(defmethod (regint-explorer :write-ireg-to-hardware) (data)
  (spi-write-ir data))

(defmethod (regint-explorer :read-mfo) ()
  lam-saved-mfobus)

(defmethod (regint-explorer :read-nubus) (adr &optional check-for-bus-error)
  (rav-write-func-dest rav-func-dest-vma-start-unmapped-read adr)
  (cond ((null check-for-bus-error)
	 (rav-read-func-src rav-m-src-md))
	(t
	 (ferror nil "foo"))
	))
    
  
;---


(defmethod (regint-explorer :stop-mach) ()
  (spi-stop)
  (SETQ LAM-RUNNING 'uinst-STEP))


(defmethod (regint-explorer :start-mach) ()
  (lam-full-restore)		;RESTORE MACHINE IF TRYING TO RUN
  (spi-run)
  (SETQ LAM-RUNNING T))

(defmethod (regint-explorer :single-step) ()
  (spi-single-step))

(defvar lam-last-inst-had-halt-bit nil)

;SAVE THINGS WHICH CAN BE SAVED WITHOUT MODIFYING THE STATE OF THE MACHINE
(defmethod (regint-explorer :passive-save) ()
  (cond ((not lam-passive-save-valid)
	 (setq lam-saved-pdl-buffer-index nil)		;FIRST OF ALL, CLEAR FLAGS
	 (setq lam-saved-micro-stack-ptr nil)		; WHICH MARK AUXILIARY PORTIONS
					 		; OF THE MACHINE NEED RESTORATION
	 (setq lam-saved-level-1-map-loc-0 nil)
	 (setq lam-vma-changed-flag nil)
	 (setq lam-saved-opcs-valid nil)
	 (setq lam-last-inst-had-halt-bit nil)
	 (setq lam-saved-dc nil)
	 (setq lam-saved-q nil)

	 (setq lam-passive-save-valid t))))



(defvar lam-saved-lpc 0)

(defvar new-full-save t)

(defmethod (regint-explorer :full-save) (&aux (imod 0) spi-status trace-adr)
  (cond ((not lam-full-save-valid)
	 (lam-stop-mach)
	 (lam-passive-save)
	 
	 (setq spi-status (spi-read-spi-status))
	 
	 (if (ldb-test (byte 1 8) spi-status)	;imod-low
	     (setq imod (spi-read-obus)))
	 (if (ldb-test (byte 1 9) spi-status)	;imod-hi
	     (setq imod (ash (spi-read-obus) 32.)))
	 
	 
	 (cond ((zerop (ldb (byte 1 12.) spi-status))	;halt FF
		(spi-trace-off)
		(setq lam-noop-flag (not (ldb-test (byte 1 7.) spi-status)))
		(setq lam-saved-ir nil)
		(spi-write-ir 0)
		(setq lam-saved-lpc (spi-read-nth-previous-pc 2))
		(setq lam-saved-pc (ldb (byte 14. 0) (spi-read-nth-previous-pc 1)))
		(spi-write-trace-ram-adr (logand 1777 (- (spi-read-trace-ram-adr) 1)))
		(setq lam-last-inst-had-halt-bit t)
		)
	       ((null new-full-save)
		(setq lam-saved-lpc (spi-read-pc))
		(setq lam-saved-ir (logior imod (spi-read-ir)))
		
		(spi-trace-off)
		(spi-single-step)		;execute inst in real IREG
		
		(setq lam-saved-pc (spi-read-pc))
		
		(setq lam-noop-flag (not (ldb-test (byte 1 7) (spi-read-spi-status))))
		
		(spi-force-noop)
		(spi-single-step)
		
		(spi-force-noop)
		(spi-single-step)
		)
	       (t
		(setq lam-saved-lpc (spi-read-pc))
		(setq lam-saved-ir (logior imod (spi-read-ir)))
		(spi-trace-off)			;have to turn off before reading adr
		(setq trace-adr (logand 1777 (spi-read-trace-ram-adr)))
		(spi-trace-on)
		(spi-execute-ireg-at-full-speed)
		(spi-trace-off)
		(spi-write-trace-ram-adr (logand 1777 trace-adr))
		(let ((trace-data (spi-read-trace-ram-data)))
		  (setq lam-saved-pc (ldb (byte 14. 0) trace-data))
		  (setq lam-noop-flag  (not (ldb-test (byte 1 15.) trace-data))))
		(spi-write-trace-ram-adr trace-adr)
		
		)
	       )
	 
	 
	 (lam-save-mem-status)
	 
	 (cond ((null lam-saved-ir)
		(setq lam-saved-ir (send self :read-c-mem lam-saved-lpc))))
	 
	 (setq memory-configuration-list nil)
	 
	 (let ((ucode-version (ldb (byte 24. 0) (send *proc* :read-a-mem #o100))))
	   (when (or (null lam-file-symbols-loaded-from)
		     (not (= ucode-version
			     (send lam-file-symbols-loaded-from :version))))
	     (cond ((lam-select-symbols-for-version-if-possible ucode-version))
		   (t
		    (format t "~&Need explorer symbols to find memory configuration.")
		    (lam-load-ucode-symbols-for-version ucode-version)))))
	 
	 (setq memory-configuration-list (get-explorer-memory-from-a-mem))
	 
	 (setq page-band-unit (lam-symbolic-examine-register 'a-disk-page-unit))
	 (when (not (<= 0 page-band-unit #o37))
	   (ferror nil "invalid disk-page-unit"))

	 (setq lam-full-save-valid t))))

(defun get-explorer-memory-from-a-mem (&aux result)
  (do ((i 0 (1+ i)))
      (())
    (let ((a-pmo (lam-lookup-name (intern (format nil "A-PMO-~d" i) "LAM")))
	  (a-pmh (lam-lookup-name (intern (format nil "A-PMH-~d" i) "LAM"))))
      (cond ((null a-pmo)
	     (return))
	    (t
	     (setq a-pmo (- a-pmo raamo))
	     (setq a-pmh (- a-pmh raamo))
	     (let ((offset (send *proc* :read-a-mem a-pmo))
		   (size (send *proc* :read-a-mem a-pmh)))
	       (cond ((zerop size)
		      (return))
		     (t
		      (push (list size offset) result))))))))

  (reverse result))
	


(defmethod (regint-explorer :full-restore) ()
  (cond (lam-full-save-valid
	 (when lam-saved-micro-stack-ptr
	   (send self :write-usp-to-hardware lam-saved-micro-stack-ptr)
	   (setq lam-saved-micro-stack-ptr nil))
	 (if lam-saved-pdl-buffer-index
	     (send self :write-pi-to-hardware lam-saved-pdl-buffer-index))
	 (setq lam-saved-pdl-buffer-index nil)
	 (if lam-saved-dc
	     (send self :write-dc-to-hardware lam-saved-dc))
	 (setq lam-saved-dc nil)
	 (if lam-saved-q
	     (send self :write-q-to-hardware lam-saved-q))
	 (setq lam-saved-q nil)
	 (lam-restore-mem-status)
	 (setq lam-full-save-valid nil)))
  (cond (lam-passive-save-valid
; execute exactly:
;  (jump-xct-next lam-saved-lpc)
;  (jump-xct-next lam-saved-pc) ;or just JUMP if lam-noop-flag
;  (lam-saved-ir)

	 (raven-execute (read)
	   rav-ir-op rav-op-jump
	   rav-ir-jump-cond rav-jump-cond-unc
	   rav-ir-n 0
	   rav-ir-jump-addr lam-saved-lpc)
	 (spi-execute-then-write-ireg
	   (raven-execute (return)
	     rav-ir-op rav-op-jump
	     rav-ir-jump-cond rav-jump-cond-unc
	     rav-ir-n (if lam-noop-flag 1 0)
	     rav-ir-jump-addr lam-saved-pc))
  (spi-trace-on)
	 (spi-execute-then-write-ireg lam-saved-ir)
	 ))
  (setq lam-passive-save-valid nil)
  )


(defmethod (regint-explorer :save-opcs) (&optional count)
  count
  nil)


(defmethod (regint-explorer :save-mem-status) ()
  (setq lam-saved-explorer-md-and-vma-enable-modes
	(ldb (byte 2 3) (spi-read-spi-status)))
  (SETQ LAM-SAVED-VMA (send self :read-vma-from-hardware))
  (SETQ LAM-SAVED-MD (send self :read-md-from-hardware))

  (spi-mdr-enable-mode 1)
  (spi-vma-enable-mode 1)

;this will reset the MDR-ENABLE bit
  (raven-execute (write)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-setm
    rav-ir-m-src rav-m-src-md
    rav-ir-func-dest rav-func-dest-md)
  (rav-abort-and-parity-off)
  )

;hack page fault bits!
(defmethod (regint-explorer :RESTORE-MEM-STATUS) ()
  (IF LAM-SAVED-LEVEL-1-MAP-LOC-0
      (send self :WRITE-L1-MAP-to-hardware 0 LAM-SAVED-LEVEL-1-MAP-LOC-0))
  (SETQ LAM-SAVED-LEVEL-1-MAP-LOC-0 NIL)
  (send self :WRITE-VMA-to-hardware LAM-SAVED-VMA)
  (spi-WRITE-MD LAM-SAVED-MD)
;  ;don't set this if user changes MD
;  (cond ((ldb-test (byte 1 0) lam-saved-explorer-md-and-vma-enable-modes)
;	 (spi-mdr-enable-mode 0)
;	 (spi-mdr-enable-mode 1)))
;  ;don't set this if user changes LC
;  (cond ((ldb-test (byte 1 1) lam-saved-explorer-md-and-vma-enable-modes)
;	 (spi-vma-enable-mode 0)
;	 (spi-vma-enable-mode 1)))
  )


(defmethod (regint-explorer :read-opc) (adr)
  (spi-read-nth-previous-pc (logand 1777 (1+ adr))))

;taken care of by lam-full-save
(defmethod (regint-explorer :release-halt) ()
  nil)



(defun rav-print-l1-map-data (data)
  (format t "~&Index ~s" (ldb (byte 6 0) data))
  (format t "~&GC ~s" (ldb (byte 3 7) data))
  (format t "~&OLD ~s" (ldb (byte 1 10.) data))
  (format t "~&Valid ~s" (ldb (byte 1 11.) data))
  (format t "~&----")
  (format t "~&Access fault ~s" (ldb (byte 1 12.) data))
  (format t "~&Write fault ~s" (ldb (byte 1 13.) data))
  (format t "~&Not Forced cycle ~s" (ldb (byte 1 14.) data))
  (format t "~&Unmapped ~s" (ldb (byte 1 15.) data))
  (format t "~&Rest ~s" (ash data -16.)))

(defun rav-print-l2-map-control-data (data)
  (format t "~&~s" data)
  (format t "~&Meta ~s" (ldb (byte 5 0) data))
  (format t "~&Map status ~s" (ldb (byte 2 6) data))
  (format t "~&Access ~s" (ldb (byte 2 8) data))
  (format t "~&Force ~s" (ldb (byte 1 10.) data))
  (format t "~&Volatility ~s" (ldb (byte 2 11.) data))
  (format t "~&Last locked ~s" (ldb (byte 1 13.) data))
  (format t "~&Last TM1 & TM0 ~s" (ldb (byte 2 14.) data))
  (format t "~&Rest ~s" (ash data -16.)))

;--

;(defun e-test ()
;  (dotimes (i 30)
;    (send *proc* :write-c-mem i 0))
;  (uload ()
;    0
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 0
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 1
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 2
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 3
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 4
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 5
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 6
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 7
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 10
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 11
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 12
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 13
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 14
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 15
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 16
;	  )
;	 (rav-ir-op rav-op-jump
;	  rav-ir-jump-cond rav-jump-cond-unc
;	  rav-ir-jump-addr 0
;	  rav-ir-n 1
;	  )
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-m-mem-dest 20
;	  )
	 
;	 )
;  )

;(defun seq-m-mem ()
;  (dotimes (i 20)
;    (send *proc* :write-m-mem i (+ 1000 i))))



;doesnt win.
(defun rav-phys-read-slow (byte-adr)
  (rav-fast-write-vma byte-adr)
  (raven-execute (write)
    rav-ir-op rav-op-alu
    rav-ir-ob rav-ob-alu
    rav-ir-aluf rav-alu-setm
    rav-ir-m-src rav-m-src-vma
    rav-ir-func-dest rav-func-dest-vma-start-unmapped-read)
  (raven-execute (write)
    rav-ir-op rav-op-alu)
  (send *proc* :read-md-from-hardware))


;(defun vread (adr)
;  (raven-execute (write)
;    rav-ir-op rav-op-alu
;    rav-ir-ob rav-ob-alu
;    rav-ir-aluf rav-alu-setz
;    rav-ir-func-dest rav-func-dest-md)
;  (spi-write-md adr)
;  (raven-execute (read)
;    rav-ir-op rav-op-alu
;    rav-ir-ob rav-ob-alu
;    rav-ir-aluf rav-alu-setm
;    rav-ir-m-src rav-m-src-md
;    rav-ir-func-dest rav-func-dest-vma-start-read)
;  (spi-execute-then-write-ireg
;    (raven-execute (return)
;      rav-ir-op rav-op-alu))
;  (spi-execute-then-write-ireg
;    (raven-execute (return)
;      rav-ir-op rav-op-alu))
;  (spi-execute-then-write-ireg
;    (raven-execute (return)
;      rav-ir-op rav-op-alu
;      rav-ir-ob rav-ob-alu
;      rav-ir-aluf rav-alu-setm
;      rav-ir-m-src rav-m-src-md
;      rav-ir-m-mem-dest 2))
;  (spi-execute-then-write-ireg 0))

;(defun vtest ()
;  (raven-execute (write)
;    rav-ir-op rav-op-alu
;    rav-ir-ob rav-ob-alu
;    rav-ir-aluf rav-alu-setm
;    rav-ir-m-src rav-m-src-md
;    rav-ir-func-dest rav-func-dest-md)
;  (rav-write-func-dest rav-func-dest-vma 0)
;  (if (not (= (rav-read-func-src rav-m-src-vma) 0))
;      (ferror nil "foo"))
;  (raven-execute (write)
;    rav-ir-op rav-op-alu
;    rav-ir-ob rav-ob-alu
;    rav-ir-aluf rav-alu-setm
;    rav-ir-m-src rav-m-src-vma
;    rav-ir-func-dest rav-func-dest-vma-start-read)
;  )

;(defun vtest3 ()
;  (spi-write-ir 0)
  
;  (spi-force-noop)
;  (spi-single-step)
  
;  (spi-force-noop)
;  (spi-single-step)
  
;  (setq lam-saved-explorer-md-and-vma-enable-modes
;	(ldb (byte 2 3) (spi-read-spi-status)))

;  (SETQ LAM-SAVED-VMA (send *proc* :read-vma-from-hardware))
;  (SETQ LAM-SAVED-MD (send *proc* :read-md-from-hardware))

;;this will reset the MDR-ENABLE bit
;  (raven-execute (write)
;    rav-ir-op rav-op-alu
;    rav-ir-ob rav-ob-alu
;    rav-ir-aluf rav-alu-setm
;    rav-ir-m-src rav-m-src-md
;    rav-ir-func-dest rav-func-dest-md)
;  )
  
;(defun vtest2 ()
;  (raven-execute (write)
;    rav-ir-op rav-op-alu
;    rav-ir-ob rav-ob-alu
;    rav-ir-aluf rav-alu-setm
;    rav-ir-m-src rav-m-src-md
;    rav-ir-func-dest rav-func-dest-md)
;  (raven-execute (read)
;    rav-ir-op rav-op-alu
;    rav-ir-ob rav-ob-alu
;    rav-ir-aluf rav-alu-setm
;    rav-ir-m-src rav-m-src-md)
;  (let ((val (spi-read-obus)))
;    (values val (nth (ldb (byte 5 25.) val) q-data-types)))
;  )

;(defun rtest ()
;  (uload ()
;    0
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setz
;	  rav-ir-func-dest rav-func-dest-vma-start-read)
;	 (rav-ir-op rav-op-alu)
;	 (rav-ir-op rav-op-alu
;	  rav-ir-halt 1)))

;(defun rav-vread (adr &aux data)
;  (rav-fast-write-vma adr)
;  (send *proc* :write-pc-to-hardware 37700)
;  (spi-run)
;  (process-sleep 2)
;  (spi-stop)

;  (let ((stop-pc (spi-read-pc)))
;    (spi-write-ir 0)
;    (spi-force-noop)
;    (spi-single-step)
;    (spi-force-noop)
;    (spi-single-step)

;    (selectq stop-pc
;      (37712
;       (setq data (send *proc* :read-md-from-hardware))
       
;       data)
;      (37713
;       (ferror nil "error page fault"))
;      (t
;       (ferror nil "unknown halt")))))

;(defun rav-vwrite (adr data)
;  (rav-fast-write-vma adr)
;  (send *proc* :write-pc-to-hardware 37701)
;  (spi-write-md data)
;  (spi-run)
;  (process-sleep 2)
;  (spi-stop)

;  (let ((stop-pc (spi-read-pc)))
;    (spi-write-ir 0)
;    (spi-force-noop)
;    (spi-single-step)
;    (spi-force-noop)
;    (spi-single-step)

;    (selectq stop-pc
;      (37712
;       nil)
;      (37713
;       (ferror nil "error page fault"))
;      (t
;       (ferror nil "unknown halt")))))

;(defun rav-phys-read (adr)
;  (rav-fast-write-vma adr)
;  (send *proc* :write-pc-to-hardware 37702)
;  (spi-run)
;  (process-sleep 2)
;  (spi-stop)

;  (let ((stop-pc (spi-read-pc)))
;    (selectq stop-pc
;      (37712
;       (send *proc* :read-md-from-hardware))
;      (37714
;;       (cerror :no-action nil nil "bus error")
;       (send *proc* :read-md-from-hardware))
;      (t
;       (ferror nil "unknown halt ~s" stop-pc)))))

;(defun rav-phys-write (adr data)
;  (rav-fast-write-vma adr)
;  (send *proc* :write-pc-to-hardware 37703)
;  (spi-write-md data)
;  (spi-run)
;  (process-sleep 2)
;  (spi-stop)

;  (let ((stop-pc (spi-read-pc)))
;    (selectq stop-pc
;      (37712
;       nil)
;      (37714
;;       (cerror :no-action nil nil "bus error")
;       )
;      (t
;       (ferror nil "unknown halt")))))

;(defun rav-setup-memory-instructions ()
;  (uload ()
;    37700
;         (rav-ir-op rav-op-jump
;	  rav-ir-jump-cond rav-jump-cond-unc
;	  rav-ir-jump-addr virtual-read
;	  rav-ir-n 1)
;    37701
;         (rav-ir-op rav-op-jump
;	  rav-ir-jump-cond rav-jump-cond-unc
;	  rav-ir-jump-addr virtual-write
;	  rav-ir-n 1)
;    37702
;         (rav-ir-op rav-op-jump
;	  rav-ir-jump-cond rav-jump-cond-unc
;	  rav-ir-jump-addr physical-read
;	  rav-ir-n 1)
;    37703
;         (rav-ir-op rav-op-jump
;	  rav-ir-jump-cond rav-jump-cond-unc
;	  rav-ir-jump-addr physical-write
;	  rav-ir-n 1)
;    37704
;         (rav-ir-op rav-op-alu) ;physical-byte-read
;    37705
;         (rav-ir-op rav-op-alu) ;physical-byte-write
;    37706
;         (rav-ir-op rav-op-alu) ;physical-halfword-read
;    37707
;         (rav-ir-op rav-op-alu) ;physical-halfword-write
;    37710
;   memory-cycle-ok
;         (rav-ir-op rav-op-alu
;	  rav-ir-halt 1)
;    37711
;   error-page-fault
;         (rav-ir-op rav-op-alu
;	  rav-ir-halt 1)
;    37712
;   nubus-error
;         (rav-ir-op rav-op-alu
;	  rav-ir-halt 1)

;         ;;((VMA-START-READ) VMA)
;   virtual-read
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setm
;	  rav-ir-m-src rav-m-src-vma
;	  rav-ir-func-dest rav-func-dest-vma-start-read)
;	 (rav-ir-op rav-op-alu)
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setm
;	  rav-ir-m-src rav-m-src-md
;	  rav-ir-func-dest rav-func-dest-md)
;	 (rav-ir-op rav-op-jump
;	  rav-ir-jump-cond rav-jump-cond-page-fault
;	  rav-ir-jump-addr error-page-fault
;	  rav-ir-n 1)
;	 (rav-ir-op rav-op-jump
;	  rav-ir-jump-cond rav-jump-cond-unc
;	  rav-ir-jump-addr memory-cycle-ok
;	  rav-ir-n 1)
;         ;;((VMA-START-WRITE) VMA)
;   virtual-write
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setm
;	  rav-ir-m-src rav-m-src-vma
;	  rav-ir-func-dest rav-func-dest-vma-start-write)
;	 (rav-ir-op rav-op-alu)
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setm
;	  rav-ir-m-src rav-m-src-md
;	  rav-ir-func-dest rav-func-dest-md)
;	 (rav-ir-op rav-op-jump
;	  rav-ir-jump-cond rav-jump-cond-page-fault
;	  rav-ir-jump-addr error-page-fault
;	  rav-ir-n 1)
;	 (rav-ir-op rav-op-jump
;	  rav-ir-jump-cond rav-jump-cond-unc
;	  rav-ir-jump-addr memory-cycle-ok
;	  rav-ir-n 1)
;         ;;((VMA-START-UNMAPPED-READ) VMA)
;   physical-read
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setm
;	  rav-ir-m-src rav-m-src-vma
;	  rav-ir-func-dest rav-func-dest-vma-start-unmapped-read)
;	 (rav-ir-op rav-op-alu)
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setm
;	  rav-ir-m-src rav-m-src-md
;	  rav-ir-func-dest rav-func-dest-md)
;	 (rav-ir-op rav-op-jump
;	  rav-ir-jump-cond rav-jump-cond-nubus-error
;	  rav-ir-jump-addr nubus-error
;	  rav-ir-n 1)
;	 (rav-ir-op rav-op-jump
;	  rav-ir-jump-cond rav-jump-cond-unc
;	  rav-ir-jump-addr memory-cycle-ok
;	  rav-ir-n 1)
;         ;;((VMA-START-UNMAPPED-WRITE) VMA)
;   physical-write
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setm
;	  rav-ir-m-src rav-m-src-vma
;	  rav-ir-func-dest rav-func-dest-vma-start-unmapped-write)
;	 (rav-ir-op rav-op-alu)
;	 (rav-ir-op rav-op-alu
;	  rav-ir-ob rav-ob-alu
;	  rav-ir-aluf rav-alu-setm
;	  rav-ir-m-src rav-m-src-md
;	  rav-ir-func-dest rav-func-dest-md)
;	 (rav-ir-op rav-op-jump
;	  rav-ir-jump-cond rav-jump-cond-nubus-error
;	  rav-ir-jump-addr nubus-error
;	  rav-ir-n 1)
;	 (rav-ir-op rav-op-jump
;	  rav-ir-jump-cond rav-jump-cond-unc
;	  rav-ir-jump-addr memory-cycle-ok
;	  rav-ir-n 1)
;	 )
;  )

;ibufs
;  0  ((vma) md)
(defun setup-ibufs ()
  (spi-load-ibuf 0 (raven-execute (return)
		     rav-ir-op rav-op-alu
		     rav-ir-ob rav-ob-alu
		     rav-ir-aluf rav-alu-setm
		     rav-ir-m-src rav-m-src-md
		     rav-ir-func-dest rav-func-dest-vma))
  (setq *ibus-setup* t)
  )

(defun rav-fast-write-vma (data)
  (spi-write-md data)
  (spi-load-ir-from-ibuf 0)
  (spi-single-step)
  (spi-force-noop)
  )  

;(defun explorer-spi-phys-read (adr &optional ignore-bus-errors byte-mode)
;  ignore-bus-errors byte-mode
;  (rav-phys-read adr))

;(defun explorer-spi-phys-write (adr data &optional ignore-bus-errors byte-mode)
;  ignore-bus-errors byte-mode
;  (rav-phys-write adr data))

;(defun spi-reload ()
;  (setup-ibufs)
;  (rav-setup-memory-instructions))