;;; -*- 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.

Questions:

We need to make a type of defafun which is an alignment within a page.
Defafuns need to provide us with program length.

The user program must guarantee that it does not use A6-A15 ever. These
are reserved for the copy program so that we can both call and jump to
the user program.

We do not handle dispatch instructions.  To do this, the relocator will need to
be smarter.

Set Up.
Memory layout
Page 0
 Trap code
 Copy code
Page 2
 User1
Page 3
 User2
Page 4
 Halt instructions.
Remaining pages are possible candidates for copying to.

(defvar *march-download-end*)
(defvar *march-parameter-block*) ;physical address
(global:defconst inst-block-size-in-bytes (* 16. 1024.))
(global:defconst map-page-size-in-bytes 4096.)

(defun march-store-parameter-block ()
  (setq *march-parameter-block* (ash *march-download-end* 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)
  setup 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))))