;;; -*- Mode:LISP; Package:LISP-INTERNALS; Base:10; Readtable:CL -*-

;; User provides a piece of code which is in two parts, each of which
;; resides on one page (probably using up less than half a page)
;; This code will be written using defafuns which can jump between
;; each other, finally jumping to a constant location, the copy routine.

;; The copy routine will work from an image of the code in low memory
;; and copy it to two pages at offsets which are different and change
;; each time the routine is called.  All the other virtual pages should
;; map to a page of all halt instructions.  The unused instructions on
;; the copied pages are halt instuctions.

(defvar *march-download-end*)
(defvar *march-parameter-block*) ;physical address

(defun march-store-parameter-block (func1 func2)
    (setq *march-parameter-block* (* *march-download-end* 8))
    (let ((x (lisp:/ *march-parameter-block* 4)))
      (lam:k-mem-write-word-address (+ x Virtual-address-original-user1)
		   (nc:ncompiled-function-starting-address (nc:nsymbol-function func1)))
      (lam:k-mem-write-word-address (+ x Virtual-address-original-user2)
		   (nc:ncompiled-function-starting-address (nc:nsymbol-function func2)))
      (lam:k-mem-write-word-address (+ x Length-user1)
		   (* 8 (nc:ncompiled-function-length (nc:nsymbol-function func1))))
      (lam:k-mem-write-word-address (+ x Length-user2)
		   (* 8 (nc:ncompiled-function-length (nc:nsymbol-function func2))))
      (lam:k-mem-write-word-address (+ x min-physical-address)
		   (* inst-block-size-in-bytes 16.))
      (lam:k-mem-write-word-address (+ x max-physical-address)
		   (* inst-block-size-in-bytes 100.))	;*** set to memory size
      (lam:k-mem-write-word-address (+ x march-pass-counter) 0)
      (lam:k-mem-write-word-address (+ x halt-page-vadr)
		   (* inst-block-size-in-bytes 15.))

      (lam:k-mem-write-word-address (+ x physical-address-1)
		   (* inst-block-size-in-bytes 16.))
      (lam:k-mem-write-word-address (+ x physical-address-2)
		   (* inst-block-size-in-bytes 17.))

      (lam:k-mem-write-word-address (+ x Copy-location-user1)
		   (+ (ash 1 25.) (lam:k-mem-read-word-address (+ x physical-address-1))))
      (lam:k-mem-write-word-address (+ x Copy-location-user2)
		   (+ (ash 1 25.) (lam:k-mem-read-word-address (+ x physical-address-2))))
      ))

(defun march-print-parameter-block (&optional (adr *march-parameter-block*))
    (let ((x (lisp:/ adr 4)))
      (lisp:format t "~&Virtual-address-original-user1 ~x"
		   (lam:k-mem-read-word-address (+ x Virtual-address-original-user1)))
      (lisp:format t "~&Virtual-address-original-user2 ~x"
		   (lam:k-mem-read-word-address (+ x Virtual-address-original-user2)))
      (lisp:format t "~&Length-user1 ~x"
		   (lam:k-mem-read-word-address (+ x Length-user1)))
      (lisp:format t "~&Length-user2 ~x"
		   (lam:k-mem-read-word-address (+ x Length-user2)))
      (lisp:format t "~&min-physical-address ~x"
		   (lam:k-mem-read-word-address (+ x min-physical-address)))
      (lisp:format t "~&max-physical-address ~x"
		   (lam:k-mem-read-word-address (+ x max-physical-address)))
      (lisp:format t "~&march-pass-counter ~x"
		   (lam:k-mem-read-word-address (+ x march-pass-counter)))
      (lisp:format t "~&halt-page-vadr ~x"
		   (lam:k-mem-read-word-address (+ x halt-page-vadr)))
      
      (lisp:format t "~&physical-address-1 ~x"
		   (lam:k-mem-read-word-address (+ x physical-address-1)))
      (lisp:format t "~&physical-address-2 ~x"
		   (lam:k-mem-read-word-address (+ x physical-address-2)))
      
      (lisp:format t "~&Copy-location-user1 ~x"
		   (lam:k-mem-read-word-address (+ x Copy-location-user1)))
      (lisp:format t "~&Copy-location-user2 ~x"
		   (lam:k-mem-read-word-address (+ x Copy-location-user2)))
      ))

(defun read-march-pass ()
  (lam:k-mem-read (+ *march-parameter-block* (* 4 march-pass-counter))))

(defun march-store-halts ()
  (let ((adr (lisp:/ (lam:k-mem-read (+ *march-parameter-block* (* 4 halt-page-vadr))) 4)))
    (dotimes (i 1024.)
      (lam:k-mem-write-word-address (+ adr i) -1))))

;;stolen from vc-test-driver
(defun run-march (user-func-1 user-func-2)
  (setq k-kbug:*loaded-functions* nil)
  (unless (nc:nsymbol-function user-func-1)
    (lisp:error "~&~s is has not been assembled. (Are you looking in the li: package?)" user-func-1))
  (unless (nc:nsymbol-function user-func-2)
    (lisp:error "~&~s is has not been assembled. (Are you looking in the li: package?)" user-func-2))
  (vc-clear-k)
  (setq k-kbug:*code-start* 0)		;read-inst-physical-with-offset (in turn disassemble) looks at this.
  (vc-load-global-constant-frame)
  (vc-download-trap-handlers)
  (march-link-and-download-test-code user-func-1 user-func-2)
  (lam:write-inst k-test-entry-loc
		  (nc:assemble-inst `(k:jump , (vc-test-entry 'march-driver) nil)))
  (lam:write-inst k-test-pass-exit-loc (nc:assemble-inst `(k:jump ,k-test-pass-halt-loc nil)))
  (lam:write-inst k-test-fail-exit-loc (nc:assemble-inst `(k:jump ,k-test-fail-halt-loc nil)))

  (march-initialize-memory-map)


  (march-store-parameter-block user-func-1 user-func-2)
  (march-store-halts)
  (lam:k-mem-write-word-address k-test-word-arg0-loc *march-parameter-block*)

  (lam:falcon-set-pc  (vc-test-entry 'march-driver)
			     :do-init t
			     :do-initialize-call-hardware t
			     :do-init-virtual-memory nil
			     :memory-control-register #x40000)  ;disable prom and traps off.
  (lam:falcon-stop-clearing-spy-mode)
  (do ()
      ((k-kbug:k-halted-p)
       (lisp:format t "~&halted"))
    (lisp:format t "~&pass ~d; " (lam:k-mem-read (+ *march-parameter-block* (* 4 march-pass-counter))))
    (lisp:sleep 1)))

(defun march-roundup (n)
  (* (ceiling n (lisp:/ inst-block-size-in-bytes 8)) (lisp:/ inst-block-size-in-bytes 8)))

(defun march-link-and-download-test-code (test1 test2)
  (let ((starting-address 0))
  ;link test code
    (setq starting-address (vc-link-and-increment 'k-test-setup starting-address))	;must be first.
    (setq starting-address (vc-link-and-increment 'march-driver starting-address))
    (dolist (fctn (lisp:get test1 'vc-support-functions))
      (when (null (nc:nsymbol-function fctn))
	(lisp:error "Test ~s requires support function ~s." test1 fctn))
      (setq starting-address (vc-link-and-increment fctn starting-address)))
    (setq starting-address (march-roundup starting-address))
    (setq starting-address (vc-link-and-increment test1 starting-address))
    (setq starting-address (march-roundup starting-address))
    (setq starting-address (vc-link-and-increment test2 starting-address))
    (setq *march-download-end* starting-address)
    )
  (let ((starting-address 0))
  ;link again and download
    (setq starting-address (vc-link-and-increment-and-download 'k-test-setup starting-address))
    (setq starting-address (vc-link-and-increment-and-download 'march-driver starting-address))
    (dolist (fctn (lisp:get test1 'vc-support-functions))
      (setq starting-address (vc-link-and-increment-and-download fctn starting-address)))
    (setq starting-address (march-roundup starting-address))
    (setq starting-address (vc-link-and-increment-and-download test1 starting-address))
    (setq starting-address (march-roundup starting-address))
    (setq starting-address (vc-link-and-increment-and-download test2 starting-address)))
  (setq *last-test-downloaded* test1))

(defun march-initialize-memory-map ()
  (let ((npages (ceiling (* 8 *march-download-end*) map-page-size-in-bytes)))
    (dotimes (i npages)
      (lam:falcon-write-map-and-check i (+ (* i map-page-size-in-bytes) #x8f))
      (lam:falcon-write-map-and-check (+ #x8000 i) (+ (* i map-page-size-in-bytes) #x8f)))))


(defafun mtest1 ()
  (return a0))

(defafun mtest2 ()
  (return a0))