;;; -*- 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 *march-parameter-block*))
      (k-mem-write (+ x (* 4 Virtual-address-original-user1))
		   (nc:ncompiled-function-starting-address (nc:nsymbol-function func1)))
      (k-mem-write (+ x (* 4 Virtual-address-original-user2))
		   (nc:ncompiled-function-starting-address (nc:nsymbol-function func2)))
      (k-mem-write (+ x (* 4 Length-user1))
		   (* 8 (nc:ncompiled-function-length (nc:nsymbol-function func1))))
      (k-mem-write (+ x (* 4 Length-user2))
		   (* 8 (nc:ncompiled-function-length (nc:nsymbol-function func2))))
      (k-mem-write (+ x (* 4 min-physical-address))
		   (* inst-block-size-in-bytes 16.))
      (k-mem-write (+ x (* 4 max-physical-address))
		   (* inst-block-size-in-bytes 100.))	;*** set to memory size
      (k-mem-write (+ x (* 4 march-pass-counter)) 0)
      (k-mem-write (+ x (* 4 halt-page-vadr))
		   (* inst-block-size-in-bytes 15.))

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

      (k-mem-write (+ x (* 4 Copy-locaton-user1))
		   (+ (ash 1 25.) (k-mem-read (+ x (* 4 physical-address-1)))))
      (k-mem-write (+ x (* 4 Copy-location-user2))
		   (+ (ash 1 25.) (k-mem-read (+ x (* 4 physical-address-2)))))
      ))

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

;;stolen from vc-test-driver
(defun run-march (user-func-1 user-func-2)
  (unless (nc:nsymbol-function test)
    (lisp:error "~&~s is has not been assembled. (Are you looking in the li: package?)" test))
  (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-func2)
  (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)
  (march-store-halts)
  store virtual address of *march-paramter-block* in a15
  (lam:falcon-set-pc-and-go  (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.

  (do ()
      ((k-bug:k-halted-p)
       (format t "~&halted"))
    (format t "~&pass ~d; " (lam:k-mem-read 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 test 'vc-support-functions))
      (when (null (nc:nsymbol-function fctn))
	(lisp:error "Test ~s requires support function ~s." test 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 test '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* test))

(defun march-initialize-memory-map ()
  (let ((npages (ceiling *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))))