;;;;;-*- Mode:LISP; Package:LAMBDA; Base:8; Readtable:ZL -*-
;;;
;;; (c) Copyright 1984,1985,1986 - Lisp Machine, Inc.
;;;

;;-NOTE--  before compiling this, make sure debug-uinst is compiled and loaded 
;;         also NU-DEBUG, SPY

;;this file contains the functions for hacking the directly accessible locations of the
;;processor, starting with the RG board

(DEFUN READ-STAT-COUNTER ()
  (LAM-EXECUTE (READ)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-M-SRC LAM-M-SRC-STAT-COUNTER
	       LAM-IR-ALUF LAM-ALU-SETM)
  (READ-MFO))

(DEFUN WRITE-STAT-COUNTER (DATA &OPTIONAL MAKE-SURE &AUX TEMP)
  (PROG NIL 
     TOP (WRITE-SPY-REG-AND-CHECK DATA)
	(LAM-EXECUTE (WRITE)
		     LAM-IR-OP LAM-OP-ALU
		     LAM-IR-OB LAM-OB-ALU
		     LAM-IR-M-SRC lam-m-src-spy-reg
		     LAM-IR-FUNC-DEST LAM-FUNC-DEST-STAT-COUNTER
		     LAM-IR-ALUF LAM-ALU-SETM)
	(COND ((AND MAKE-SURE (NOT (= (SETQ TEMP (READ-STAT-COUNTER)) DATA)))
	       (FORMAT T "~%Wrote ~O, Read back ~O, trying again " DATA TEMP)
	       (GO TOP)))))

(DEFUN READ-AUX-STAT-COUNTER ()
  (LAM-EXECUTE (READ)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-M-SRC LAM-M-SRC-STAT-COUNTER-AUX
	       LAM-IR-ALUF LAM-ALU-SETM)
  (READ-MFO))

(DEFUN WRITE-AUX-STAT-COUNTER (DATA &OPTIONAL MAKE-SURE &AUX TEMP)
  (PROG NIL 
     TOP (WRITE-SPY-REG-AND-CHECK DATA)
	(LAM-EXECUTE (WRITE)
		     LAM-IR-OP LAM-OP-ALU
		     LAM-IR-OB LAM-OB-ALU
		     LAM-IR-M-SRC lam-m-src-spy-reg
		     LAM-IR-FUNC-DEST LAM-FUNC-DEST-STAT-COUNTER-AUX
		     LAM-IR-ALUF LAM-ALU-SETM)
	(COND ((AND MAKE-SURE (NOT (= (SETQ TEMP (READ-AUX-STAT-COUNTER)) DATA)))
	       (FORMAT T "~%Wrote ~O, Read back ~O, trying again " DATA TEMP)
	       (GO TOP)))))

(DEFUN WRITE-STAT-COUNTER-STEPPING (DATA)
  (WRITE-SPY-REG-AND-CHECK DATA)
  (LAM-EXECUTE (EXECUTOR LAM-EXECUTE-NOCLOCKS)
    LAM-IR-OP LAM-OP-ALU
    LAM-IR-OB LAM-OB-ALU
    LAM-IR-M-SRC lam-m-src-spy-reg
    LAM-IR-FUNC-DEST LAM-FUNC-DEST-STAT-COUNTER
    LAM-IR-ALUF LAM-ALU-SETM)
  (SM-STEP-LOOP))

(DEFUN STAT-COUNTER-TEST-LOOP (DATA)
  (WRITE-STAT-COUNTER DATA)
  (DO ((COUNTER DATA (1+ COUNTER))
       (VALUE))
      (())
    (COND ((NOT (= (SETQ VALUE (READ-AND-INCREMENT-STAT-COUNTER)) COUNTER))
	       (FORMAT T "~%Read ~O, Should be ~O " VALUE COUNTER)))))

(DEFUN READ-AND-INCREMENT-STAT-COUNTER (&AUX TEMP)
  (LAM-EXECUTE (READ)						;stat-counter
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-M-SRC LAM-M-SRC-STAT-COUNTER
	       LAM-IR-ALUF LAM-ALU-SETM)
  (SETQ TEMP (READ-MFO))
  (LAM-EXECUTE (UINST-CLOCK)
       	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-STAT-BIT 1)
  TEMP)

(DEFUN WRITE-AND-INCREMENT-STAT-COUNTER (DATA)
  (WRITE-SPY-REG-AND-CHECK DATA)				;stat-counter
  (LAM-EXECUTE (WRITE)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-M-SRC lam-m-src-spy-reg
	       LAM-IR-FUNC-DEST LAM-FUNC-DEST-STAT-COUNTER
	       LAM-IR-ALUF LAM-ALU-SETM)
  (LAM-EXECUTE (UINST-CLOCK)
       	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-STAT-BIT 1))

(DEFUN STAT-COUNTER-TEST-LOOP (DATA)
  (WRITE-STAT-COUNTER DATA)
  (DO ((COUNTER DATA (1+ COUNTER))
       (VALUE))
      (())
    (COND ((NOT (= (SETQ VALUE (READ-AND-INCREMENT-STAT-COUNTER)) COUNTER))
	       (FORMAT T "~%Read ~O, Should be ~O " VALUE COUNTER)))))

(DEFUN READ-AND-INCREMENT-AUX-STAT-COUNTER (&AUX TEMP)
  (LAM-EXECUTE (READ)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-M-SRC LAM-M-SRC-STAT-COUNTER-AUX
	       LAM-IR-ALUF LAM-ALU-SETM)
  (SETQ TEMP (READ-MFO))
  (LAM-EXECUTE (UINST-CLOCK)
       	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-STAT-BIT 1)
  TEMP)

(DEFUN WRITE-AND-INCREMENT-AUX-STAT-COUNTER (DATA)
  (WRITE-SPY-REG-AND-CHECK DATA)
  (LAM-EXECUTE (WRITE)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-M-SRC lam-m-src-spy-reg
	       LAM-IR-FUNC-DEST LAM-FUNC-DEST-STAT-COUNTER-AUX
	       LAM-IR-ALUF LAM-ALU-SETM)
  (LAM-EXECUTE (UINST-CLOCK)
       	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-STAT-BIT 1))

(defun lam-select-stat2-clock ()
  (LET ((RG-MODE (READ-RG-MODE)))
    (WRITE-RG-MODE (DPB 0 AUX-STAT-CLOCK-CONTROL
			(DPB 6 AUX-STAT-COUNT-CONTROL-BITS RG-MODE)))))

(defun test-stat2-clock (&optional (length-of-test-in-seconds 120.))
  (lam-select-stat2-clock)
  (write-aux-stat-counter 0)
  (uinst-jump-loop)
  (lam-dummy-full-save)
  (lam-register-deposit rasa 100)		
  (lam-register-deposit rago 1)
  (let ((last-stat2 0))
    (dotimes (s length-of-test-in-seconds)
      (process-sleep 60.)
      (lam-register-deposit rastop 0)
      (let ((stat2 (lam-register-examine rastat-aux)))
	(cond ((not (< (abs (- stat2 last-stat2 1000000.)) 100000.))
	       (format t "~%Bad stat2-clock after ~D seconds, stat2 = ~d, previously ~d"
		       s
		       stat2
		       last-stat2)))
	(setq last-stat2 stat2))
      (lam-register-deposit rago 1)))
  (lam-register-deposit rastop 0))

(DEFUN READ-LC ()
  (LAM-EXECUTE (READ)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-M-SRC LAM-M-SRC-LC
	       LAM-IR-ALUF LAM-ALU-SETM)
  (READ-MFO))

(DEFUN WRITE-LC (DATA &OPTIONAL MAKE-SURE &AUX TEMP)
  (PROG NIL 
     TOP (WRITE-SPY-REG-AND-CHECK DATA)
	(LAM-EXECUTE (WRITE)
		     LAM-IR-OP LAM-OP-ALU
		     LAM-IR-OB LAM-OB-ALU
		     LAM-IR-M-SRC lam-m-src-spy-reg
		     LAM-IR-FUNC-DEST LAM-FUNC-DEST-LC
		     LAM-IR-ALUF LAM-ALU-SETM)
	(COND ((AND MAKE-SURE (NOT (= (SETQ TEMP (READ-LC)) DATA)))
	       (FORMAT T "~%Wrote ~O, Read back ~O, trying again " DATA TEMP)
	       (GO TOP)))))

(DEFCONST *INCREMENT-LC-ON-UINST-DONE* 1_18.	;WOULD YOU BELIEVE PUTTING THIS IN
 "WHEN THIS VALUE IS POPPED FROM THE MICRO STACK, THEN THE LOCATION COUNTER IS INCREMENTED")
						;THE MICRO PC CAUSES THE MACRO PC
 						;TO INCREMENT?  NO???

(DEFUN WRITE-AND-INCREMENT-LC (DATA)
      (WRITE-SPY-REG-AND-CHECK DATA)
      (LAM-EXECUTE (WRITE)
		     LAM-IR-OP LAM-OP-ALU
		     LAM-IR-OB LAM-OB-ALU
		     LAM-IR-M-SRC lam-m-src-spy-reg
		     LAM-IR-FUNC-DEST LAM-FUNC-DEST-LC
		     LAM-IR-ALUF LAM-ALU-SETM)
      (INCREMENT-USP-AND-WRITE-US *INCREMENT-LC-ON-UINST-DONE*)
      (LAM-EXECUTE (WRITE)
 		     LAM-IR-OP LAM-OP-JUMP
		     LAM-IR-R  1
		     LAM-IR-JUMP-COND LAM-JUMP-COND-UNC))





(DEFUN WRITE-LC-STEPPING (DATA)
  (WRITE-SPY-REG-AND-CHECK DATA)
  (LAM-EXECUTE (EXECUTOR LAM-EXECUTE-NOCLOCKS)
    LAM-IR-OP LAM-OP-ALU
    LAM-IR-OB LAM-OB-ALU
    LAM-IR-M-SRC lam-m-src-spy-reg
    LAM-IR-FUNC-DEST LAM-FUNC-DEST-LC
    LAM-IR-ALUF LAM-ALU-SETM)
  (SM-STEP-LOOP))




(defun test-both-stat-counters-count-the-same ()
  ;(jump 0) (no-op)
  (uload ()
   0
	 (lam-ir-op lam-op-jump
	  lam-ir-jump-cond lam-jump-cond-unc
	  lam-ir-jump-addr 0
	  lam-ir-n 1
	  )
	 (lam-ir-op lam-op-alu))
  (change-rg-mode '(AUX-STAT-COUNT-CONTROL-BITS 7	;HI .. count every tick
		    aux-stat-clock-control 0	;count on SM.CLOCK
		    MAIN-STAT-COUNT-CONTROL-BITS 7	;HI
		    main-stat-clock-control 0	;count on SM.CLOCK
		    ))
  
  )

(defun loop-reading-main-stat ()
  ;(jump-xct-next 0) (setm stat-counter)
  (uload ()
   0
	 (lam-ir-op lam-op-jump
	  lam-ir-jump-cond lam-jump-cond-unc
	  lam-ir-jump-addr 0
	  lam-ir-n 0
	  )
	 (lam-ir-op lam-op-alu
	  lam-ir-ob lam-ob-alu
	  lam-ir-m-src lam-m-src-stat-counter
	  lam-ir-aluf lam-alu-setm)
	 )
  (change-rg-mode '(AUX-STAT-COUNT-CONTROL-BITS 7	;HI .. count every tick
		    aux-stat-clock-control 0	;count on SM.CLOCK
		    MAIN-STAT-COUNT-CONTROL-BITS 7	;HI
		    main-stat-clock-control 0	;count on SM.CLOCK
		    ))
  
  (write-stat-counter 0)
  (write-aux-stat-counter 0)
  (setup-machine-to-start-at 0)
  )

(defun loop-comparing-stats ()
  ;((1@m) stat-counter)
  ;((2@m) m-a-1 stat-counter-aux 1@a)
  ;(jump-equal 2@m 3@m 0)
  ;(jump 0 halt)
    (uload ()
	   0
	   (lam-ir-op lam-op-alu
	    lam-ir-ob lam-ob-alu
	    lam-ir-m-src lam-m-src-stat-counter
	    lam-ir-aluf lam-alu-setm
	    lam-ir-m-mem-dest 1
	    lam-ir-stat-bit 1
	    )
						;1
	   (lam-ir-op lam-op-alu
	    lam-ir-ob lam-ob-alu
	    lam-ir-m-src lam-m-src-stat-counter-aux
	    lam-ir-a-src 1
	    lam-ir-aluf lam-alu-m-a-1
	    lam-ir-m-mem-dest 2
	    )
						;2
	   (lam-ir-op lam-op-jump
	    lam-ir-jump-cond lam-jump-cond-m=a
	    lam-ir-jump-addr 0
	    lam-ir-n 1
	    lam-ir-m-src 2
	    lam-ir-a-src 3
	    )
						;3
	   (lam-ir-op lam-op-alu
	    lam-ir-ob lam-ob-alu
	    lam-ir-m-src 2
	    lam-ir-m-mem-dest 3
	    lam-ir-aluf lam-alu-setm)
						;4
	   (lam-ir-op lam-op-jump
	    lam-ir-jump-cond lam-jump-cond-unc
	    lam-ir-jump-addr 0
	    lam-ir-n 1
	    lam-ir-halt 0)
	   (lam-ir-op lam-op-alu)
	   (lam-ir-op lam-op-alu)
	   (lam-ir-op lam-op-alu)
	   (lam-ir-op lam-op-alu)
	   )
  (change-rg-mode '(AUX-STAT-COUNT-CONTROL-BITS 7	;HI .. count every tick
		    aux-stat-clock-control 1	;count on SM.CLOCK
		    MAIN-STAT-COUNT-CONTROL-BITS 7	;HI
		    main-stat-clock-control 1	;count on SM.CLOCK
		    ))
  
  (write-m-mem 3 15)
;  (write-m-mem 3 0)
  (write-aux-stat-counter 0)
  (write-stat-counter 0)
  (setup-machine-to-start-at 0)
  )

(defun loop-reading-same-thing-out-of-stat (&optional (val 0))
  ;(no-op)
  ;((1@m) stat-counter)
  ;(jump-equal 1@m 3@m 0)
  ;(jump-xct-next 0)
  ;((3@m) 1@m)
  (uload ()
   0
	 (lam-ir-op lam-op-alu)
	 ;1
	 (lam-ir-op lam-op-alu
	  lam-ir-ob lam-ob-alu
	  lam-ir-m-src lam-m-src-stat-counter
	  lam-ir-aluf lam-alu-setm
	  lam-ir-m-mem-dest 1
	  lam-ir-stat-bit 1
	  )
	 ;2
	 (lam-ir-op lam-op-jump
	  lam-ir-jump-cond lam-jump-cond-m=a
	  lam-ir-jump-addr 0
	  lam-ir-n 1
	  lam-ir-m-src 1
	  lam-ir-a-src 3
	  )
	 ;3
	 (lam-ir-op lam-op-alu
	  lam-ir-ob lam-ob-alu
	  lam-ir-m-src 1
	  lam-ir-m-mem-dest 3
	  lam-ir-aluf lam-alu-setm)
	 ;4
	 (lam-ir-op lam-op-jump
	  lam-ir-jump-cond lam-jump-cond-unc
	  lam-ir-jump-addr 0
	  lam-ir-n 1
	  lam-ir-halt 0)
	 (lam-ir-op lam-op-alu)
	 (lam-ir-op lam-op-alu)
	 (lam-ir-op lam-op-alu)
	 (lam-ir-op lam-op-alu)
	 )
  (change-rg-mode '(AUX-STAT-COUNT-CONTROL-BITS 5	;T.statistics.bit
		    aux-stat-clock-control 0	;count on SM.CLOCK
		    MAIN-STAT-COUNT-CONTROL-BITS 5	;T.statistics.bit
		    main-stat-clock-control 0	;count on SM.CLOCK
		    ))
  
  (write-m-mem 3 0)
  (write-aux-stat-counter val)
  (write-stat-counter val)
  (setup-machine-to-start-at 0)
  )