;;;-*-mode:lisp;package:lambda;base:8.-*-

(defselect (PDL-POINTER-PASS-AROUND-ACTOR)
  (:read (address) address
    *PASS-AROUND-DATA*)
  (:write (address data) address
    (WRITE-SPY-REG DATA)
    (LAM-EXECUTE (UINST-CLOCK-PLUS-UINST-CLOCK-LOW)
	LAM-IR-M-SRC LAM-M-SRC-SPY-REG
	LAM-IR-ALUF LAM-ALU-SETM 
	LAM-IR-OB LAM-OB-ALU
	LAM-IR-FUNC-DEST LAM-FUNC-DEST-C-PP)		;ADR
    (LAM-EXECUTE (EXECUTOR LAM-EXECUTE-R-NO-CHECK)
		  LAM-IR-M-SRC LAM-M-SRC-C-PP
		  LAM-IR-ALUF LAM-ALU-SETM
		  LAM-IR-OB LAM-OB-ALU)
    (SETQ *PASS-AROUND-DATA* (READ-MFO))
    (ADVANCE-TO-NEXT-UINST-CLOCK)
    (FORCE-UINST-CLOCK-LOW)
    ))

(defun test-c-pp-pass-data-path ()
  (test-data-path "pdl-pointer-pass-around" 'pdl-pointer-pass-around-actor 32.))

(defselect (PDL-INDEX-PASS-AROUND-ACTOR)
  (:read (address) address
    *PASS-AROUND-DATA*)
  (:write (address data) address
    (WRITE-SPY-REG DATA)
    (LAM-EXECUTE (UINST-CLOCK-PLUS-UINST-CLOCK-LOW)
	LAM-IR-M-SRC LAM-M-SRC-SPY-REG
	LAM-IR-ALUF LAM-ALU-SETM 
	LAM-IR-OB LAM-OB-ALU
	LAM-IR-FUNC-DEST LAM-FUNC-DEST-C-PI)		;ADR
    (LAM-EXECUTE (EXECUTOR LAM-EXECUTE-R-NO-CHECK)
		  LAM-IR-M-SRC LAM-M-SRC-c-PI
		  LAM-IR-ALUF LAM-ALU-SETM
		  LAM-IR-OB LAM-OB-ALU)
    (SETQ *PASS-AROUND-DATA* (READ-MFO))
    (ADVANCE-TO-NEXT-UINST-CLOCK)
    (FORCE-UINST-CLOCK-LOW)
    ))

(defun test-c-pi-pass-data-path ()
  (test-data-path "pdl-index-pass-around" 'pdl-index-pass-around-actor 32.))

(DEF-UTEST FAST-TEST-PDL-PP-PI-AND-M-PASS-AROUND "C-PP C-PI C-MEM PASS AROUND TEST"

  :ARGUMENTS (MAX START-FOR-PP START-FOR-PI START-FOR-MEM)
  
  :CONSTANTS ((M-CONTENTS-OF-PP 4)
	      (M-CONTENTS-OF-PI 5)
	      (M-CONTENTS-OF-MEM 6)
	      (M-SCRATCH-OF-PP 7)
	      (M-SCRATCH-OF-PI 8.)
	      (M-SCRATCH-OF-MEM 9.)
	      (M-TIMES 10.)
	      (M-NUMBER-OF-TIMES-MAX 11.)
	      (M-CONTENTS-OF-MEM-DEST 12.))

  :INPUT-VALUES (((M-MEM M-CONTENTS-OF-PP) 'START-FOR-PP)
		 ((M-MEM M-CONTENTS-OF-PI) 'START-FOR-PI)
		 ((M-MEM M-CONTENTS-OF-MEM) 'START-FOR-MEM)
		 ((M-MEM M-NUMBER-OF-TIMES-MAX) 'MAX)
		 ((m-mem m-times) 0))

  :ERROR-STOPS ((ERROR-PP "ERROR IN PASS AROUND OF CONTENTS OF LOCATION POINTED TO BY PP")
		(ERROR-PI "ERROR IN PASS AROUND OF CONTENTS OF LOCATION POINTED TO BY PI")
		(ERROR-M "ERROR IN PASS AROUND OF CONTENTS OF M MEMORY"))

  :GOOD-STOP GS

  :TIME-OUT 30.

  :START START-LOOP

  :CODE (

     START-LOOP
     
        (LAM-IR-OP LAM-OP-ALU
	 LAM-IR-OB LAM-OB-ALU
	 LAM-IR-M-SRC M-CONTENTS-OF-PP
	 LAM-IR-FUNC-DEST LAM-FUNC-DEST-C-PP
	 LAM-IR-ALUF LAM-ALU-SETM)

	(LAM-IR-OP LAM-OP-ALU
	 LAM-IR-OB LAM-OB-ALU
	 LAM-IR-M-MEM-DEST M-SCRATCH-OF-PP
	 LAM-IR-M-SRC LAM-M-SRC-C-PP
	 LAM-IR-ALUF LAM-ALU-SETM)

	(LAM-IR-OP LAM-OP-ALU
	 LAM-IR-OB LAM-OB-ALU
	 LAM-IR-M-SRC M-CONTENTS-OF-PI
	 LAM-IR-FUNC-DEST LAM-FUNC-DEST-C-PI
	 LAM-IR-ALUF LAM-ALU-SETM)

	(LAM-IR-OP LAM-OP-ALU
	 LAM-IR-OB LAM-OB-ALU
	 LAM-IR-M-MEM-DEST M-SCRATCH-OF-PI
	 LAM-IR-M-SRC LAM-M-SRC-C-PI
	 LAM-IR-ALUF LAM-ALU-SETM)

	(LAM-IR-OP LAM-OP-ALU
	 LAM-IR-OB LAM-OB-ALU
	 LAM-IR-M-SRC M-CONTENTS-OF-MEM
	 LAM-IR-M-MEM-DEST M-CONTENTS-OF-MEM-DEST 
	 LAM-IR-ALUF LAM-ALU-SETM)

	(LAM-IR-OP LAM-OP-ALU
	 LAM-IR-OB LAM-OB-ALU
	 LAM-IR-M-SRC M-CONTENTS-OF-MEM-DEST
	 LAM-IR-M-MEM-DEST M-SCRATCH-OF-MEM
	 LAM-IR-ALUF LAM-ALU-SETM)

	(LAM-IR-OP LAM-OP-JUMP
	 LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A
	 LAM-IR-JUMP-ADDR ERROR-PP-1
	 LAM-IR-M-SRC M-CONTENTS-OF-PP
	 LAM-IR-A-SRC M-SCRATCH-OF-PP
	 LAM-IR-N 1)

	(LAM-IR-OP LAM-OP-JUMP
	 LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A
	 LAM-IR-JUMP-ADDR ERROR-PI-1
	 LAM-IR-M-SRC M-CONTENTS-OF-PI
	 LAM-IR-A-SRC M-SCRATCH-OF-PI
	 LAM-IR-N 1)

	(LAM-IR-OP LAM-OP-JUMP
	 LAM-IR-JUMP-COND LAM-JUMP-COND-M-NEQ-A
	 LAM-IR-JUMP-ADDR ERROR-M-1
	 LAM-IR-M-SRC M-CONTENTS-OF-MEM
	 LAM-IR-A-SRC M-SCRATCH-OF-MEM
	 LAM-IR-N 1)

	(LAM-IR-OP LAM-OP-ALU
	 LAM-IR-OB LAM-OB-ALU
	 LAM-IR-ALUF LAM-ALU-M+1
	 LAM-IR-M-SRC M-CONTENTS-OF-PP
	 LAM-IR-M-MEM-DEST M-CONTENTS-OF-PP)

	(LAM-IR-OP LAM-OP-ALU
	 LAM-IR-OB LAM-OB-ALU
	 LAM-IR-ALUF LAM-ALU-M+1
	 LAM-IR-M-SRC M-CONTENTS-OF-PI
	 LAM-IR-M-MEM-DEST M-CONTENTS-OF-PI)

	(LAM-IR-OP LAM-OP-ALU
	 LAM-IR-OB LAM-OB-ALU
	 LAM-IR-ALUF LAM-ALU-M+1
	 LAM-IR-M-SRC M-CONTENTS-OF-MEM
	 LAM-IR-M-MEM-DEST M-CONTENTS-OF-MEM)

	(LAM-IR-OP LAM-OP-JUMP
	 LAM-IR-JUMP-COND LAM-JUMP-COND-M<=A
	 LAM-IR-JUMP-ADDR START-LOOP
	 LAM-IR-M-SRC M-TIMES
	 LAM-IR-A-SRC M-NUMBER-OF-TIMES-MAX
	 LAM-IR-N 0)

	(LAM-IR-OP LAM-OP-ALU
	 LAM-IR-OB LAM-OB-ALU
	 LAM-IR-ALUF LAM-ALU-M+1
	 LAM-IR-M-SRC M-TIMES
	 LAM-IR-M-MEM-DEST M-TIMES)

	(LAM-IR-HALT 1)	

    GS
        (LAM-IR-HALT 1)
    error-pi-1
	(lam-ir-halt 1)
    ERROR-PI
        (LAM-IR-HALT 1)
    error-pp-1
        (lam-ir-halt 1)
    ERROR-PP
        (LAM-IR-HALT 1)
    error-m-1
        (lam-ir-halt 1)
    ERROR-M
        (LAM-IR-HALT 1)

	(LAM-IR-HALT 1)))