;;; -*- Mode:LISP; Package:LAMBDA; base: 8 -*-
;;;
;;; (c) Copyright 1984 - Lisp Machine, Inc.
;;;


;;this file contains functions for testing the interrupt logic of the lambda.

(defun interrupt (location)
  (nd-slot-read rg-slot (+ 400 (logand 377 location))))


(DEFUN read-interrupt-pointer ()
  (LAM-EXECUTE (READ)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-M-SRC LAM-M-SRC-INTERRUPT-POINTER
	       LAM-IR-OB LAM-OB-ALU
	       LAM-IR-ALUF LAM-ALU-SETM)
  (READ-MFO))

(DEFUN CLEAR-INTERRUPT ()
  (LAM-EXECUTE (WRITE)
	       LAM-IR-OP LAM-OP-ALU
	       LAM-IR-FUNC-DEST LAM-FUNC-DEST-INTERRUPT-CLEAR)
  (LAM-EXECUTE (WRITE)
	       LAM-IR-OP LAM-OP-ALU))		;SECOND WRITE IS TO TICK ANOTHER UINST
						;AND RESTART THE STATE MACHINE...
						;OOPS, SOME BUG, TAKES TWO CLEARS TO DO THE
						;JOB



(DEFCONST int-test-RG-MODE-LIST
        '(SINGLE-STEP-MACRO-INST-MODE 0
	  25-BIT-VIRTUAL-ADDRESS-MODE-L 1
	  INTERRUPT-ENABLE 1
	  SEQUENCE-BREAK-L 1
	  MAIN-STAT-CLOCK-CONTROL 1
	  aux-stat-clock-control 1
	  AUX-STAT-COUNT-CONTROL 0
	  MAIN-STAT-COUNT-CONTROL-2 0
	  MAIN-STAT-COUNT-CONTROL-1 0
	  MAIN-STAT-COUNT-CONTROL-0 0
	  AUX-STAT-COUNT-CONTROL-2 0
	  AUX-STAT-COUNT-CONTROL-1 0
	  AUX-STAT-COUNT-CONTROL-0 0
	  ))

(defun set-rg-mode-for-int-test ()
  (change-rg-mode-and-check int-test-rg-mode-list))

(defun test-interrupts ()
  "start a ucode loop which finds interrupts and writes the pointer into
a-mem locations (+ pointer 16.).  Read a mem locations back, complain if error"
  (basic-interrupt-check)
  (do ((adr 0 (1+ adr)))
      ((= adr 256.))
    (interrupt adr))
  (disable-lambda)
  (do*  ((adr 16. (1+ adr))
	 (expected-data 0 (1+ expected-data))
	 (data (read-a-mem adr) (read-a-mem adr)))
       ((= adr 256.))
    (cond ((= expected-data data))
	  (t (format t "~% a-mem loc ~o contained ~o instead of ~o"
		     adr data expected-data)))))

(defun basic-interrupt-check (&aux (a-zero 1)
				   (a-constant-1400 2)
				   (a-constant-17600000 3)
				   (a-offset 4)
				   (m-wadr 5)
				   (m-temp 6))
  (lam-zero-entire-machine nil)
  (reset)
  (set-rg-mode-for-int-test)
  
  (write-m-mem a-zero 0)
  (write-m-mem a-constant-1400 1400)
  (write-m-mem a-constant-17600000 17600000)
  (write-m-mem a-offset 16.)
  (uload (a-zero a-constant-1400 a-constant-17600000 m-wadr m-temp a-offset)

	 ;;; first we set up the md,vma,and maps and do a memory cycle to clear page fault
   0
   	 (lam-ir-halt 1)			;halt if we get here randomly

	 (lam-ir-op lam-op-alu)
	 
   2
	 (lam-ir-op lam-op-alu				;((md) a-zero)
	  lam-ir-ob lam-ob-alu
	  lam-ir-aluf lam-alu-seta
	  lam-ir-a-src a-zero
	  lam-ir-func-dest lam-func-dest-md)

	 (lam-ir-op lam-op-alu				;((l1-map) a-zero)
	  lam-ir-ob lam-ob-alu
	  lam-ir-aluf lam-alu-seta
	  lam-ir-a-src a-zero
	  lam-ir-func-dest lam-func-dest-l1-map)

	 (lam-ir-op lam-op-alu				;((l2-map-control) (a-constant 1400))
	  lam-ir-ob lam-ob-alu
	  lam-ir-aluf lam-alu-seta
	  lam-ir-a-src a-constant-1400
	  lam-ir-func-dest lam-func-dest-l2-map-control)

	 (lam-ir-op lam-op-alu				;((l2-map-physical-page)
		   					;              (a-constant 17600000))
	  lam-ir-ob lam-ob-alu
	  lam-ir-aluf lam-alu-seta
	  lam-ir-a-src a-constant-17600000
	  lam-ir-func-dest lam-func-dest-l2-map-physical-page)

	 (lam-ir-op lam-op-alu				;((vma-start-read) a-zero)
	  lam-ir-ob lam-ob-alu
	  lam-ir-aluf lam-alu-seta
	  lam-ir-a-src a-zero
	  lam-ir-func-dest lam-func-dest-vma-start-read)

	 (lam-ir-op lam-op-jump                       ;(jump icheck)
	  lam-ir-jump-cond lam-jump-cond-unc
	  lam-ir-jump-addr icheck
	  lam-ir-n 1)

	 (lam-ir-op lam-op-alu)			;extra cycle

	 (lam-ir-halt 1)			;halt if we fall through the inits

estop1	 (lam-ir-op lam-op-alu)			;

	 ;;; now we loop until we have an interrupt, at which point we halt.
	 ;;; if we proceed, we clear the interrupt and start from zero again
	 
	 (lam-ir-halt 1)			;halt if we get here randomly

estop2	 (lam-ir-op lam-op-alu)

icheck
	 (lam-ir-op lam-op-alu)		          	;extra cycle
	 
	 (lam-ir-op lam-op-jump                    ;(jump-if-not-page-fault-or-interrupt 10)
	  lam-ir-jump-cond lam-jump-cond-page-fault-or-interrupt
	  lam-ir-jump-invert-condition 1
	  lam-ir-jump-addr icheck
	  lam-ir-n 1)

	 ;;  write the interrupt pointer into a-mem at (+ int-pointer offset) 

	 (lam-ir-op lam-op-alu			;((m-wadr) add a-offset interrupt-pointer)
	  lam-ir-ob lam-ob-alu			;
	  lam-ir-aluf lam-alu-setm
	  lam-ir-m-src lam-m-src-interrupt-pointer
	  lam-ir-m-mem-dest m-temp)

	 (lam-ir-op lam-op-alu	
	  lam-ir-ob lam-ob-alu		
	  lam-ir-aluf lam-alu-add
	  lam-ir-m-src m-temp
	  lam-ir-a-src a-offset
	  lam-ir-m-mem-dest m-wadr)

	 (lam-ir-op lam-op-alu)
	 (lam-ir-op lam-op-alu)
	 (lam-ir-op lam-op-alu)

	 (lam-ir-op lam-op-byte			;((imod-low)
	  lam-ir-byte-func lam-byte-func-dpb
	  lam-ir-a-src a-zero
	  lam-ir-m-src m-wadr
	  lam-ir-func-dest lam-func-dest-imod-low
	  lam-ir-bytl-1 11.
	  lam-ir-mrot 14.)

	  (lam-ir-op lam-op-alu			;((a-mem) interrupt-pointer)
	   lam-ir-ob lam-ob-alu
	   lam-ir-aluf lam-alu-setm
	   lam-ir-m-src m-temp
	   lam-ir-a-mem-dest-flag 1)

	 (lam-ir-op lam-op-alu				;((interrupt-clear))
	  lam-ir-func-dest lam-func-dest-interrupt-clear)

	 (lam-ir-op lam-op-alu)
	 (lam-ir-op lam-op-alu)
	 (lam-ir-op lam-op-alu)
	 

	 (lam-ir-op lam-op-jump			;(jump icheck)
	  lam-ir-jump-cond lam-jump-cond-unc
	  lam-ir-jump-addr icheck
	  lam-ir-n 1)

	 (lam-ir-halt 1)			;halt if we fall through
	 
	 )
  (setup-machine-to-start-at 2)
  (enable-lambda))


(defun interrupt-clear-loop ()
  (uload ()
	 0
	 (lam-ir-op lam-op-alu)			;extra cycle
	 (lam-ir-op lam-op-alu)			;extra cycle
	 (lam-ir-op lam-op-alu)			;extra cycle
	 (lam-ir-op lam-op-alu)			;extra cycle
    
	 (lam-ir-op lam-op-alu				;((interrupt-clear))
	  lam-ir-func-dest lam-func-dest-interrupt-clear)
	 
	 (lam-ir-op lam-op-jump			;(jump 0)
	  lam-ir-jump-cond lam-jump-cond-unc
	  lam-ir-jump-addr 0
	  lam-ir-n 1))
  (setup-machine-to-start-at 0))

(defun fnor ()
  (uload ()
	 0
	 (lam-ir-op lam-op-jump                    ;(jump-if-not-page-fault-or-interrupt 10)
	  lam-ir-jump-cond lam-jump-cond-page-fault-or-interrupt
	  lam-ir-jump-invert-condition 1
	  lam-ir-jump-addr 14
	  lam-ir-n 1)

	 ;;  write the interrupt pointer into a-mem at (+ int-pointer offset) 

	 (lam-ir-op lam-op-alu			;((m-wadr) add a-offset interrupt-pointer)
	  lam-ir-ob lam-ob-alu			;
	  lam-ir-aluf lam-alu-add
	  lam-ir-m-src lam-m-src-interrupt-pointer
	  lam-ir-a-src 2
	  lam-ir-m-mem-dest 4)
	 
         (lam-ir-op lam-op-jump
	  lam-ir-jump-cond lam-jump-cond-unc
	  lam-ir-jump-addr 14
	  lam-ir-n 1)
	 14
	 (lam-ir-op lam-op-jump
	  lam-ir-jump-cond lam-jump-cond-unc
	  lam-ir-jump-addr 0
	  lam-ir-n 1))
  (setup-machine-to-start-at 0)
  (sm-step-loop))

(defun enable-interrupts ()
  (change-rg-mode-and-check '(interrupt-enable 1)))


(defun jump-if-interrupt (location)
  (lam-execute (uinst-clock-plus-uinst-clock-low)
	  lam-ir-op lam-op-jump                    ;(jump-if-not-page-fault-or-interrupt 10)
	  lam-ir-jump-cond lam-jump-cond-page-fault-or-interrupt
	  lam-ir-jump-addr location
	  lam-ir-n 1)
 (cond ((= location (read-pc)) t)
       (t nil)))
