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

Begin Loop
select two new physical pages
select two new virtual pages
Map virtual pages to the physical pages
Fill the virtual pages with halt bit (using the function boundary marker)
select two new offsets in the pages

Copy each of the instructions
  Relocate the jump instructions
    scan function looking for conditional jump opcode, add offset to low 12 bits
    also, scan function looking for calls/long jumps to other function and fix them

Jump to the first Copied user function
...
Map the used virtual pages back to the halt page.
Loop.

|#

(eval-when (compile load eval)
  (global:defconst Virtual-address-original-user1 0)
  (global:defconst Virtual-address-original-user2 (1+ Virtual-address-original-user1))
  (global:defconst Copy-location-user1            2)
  (global:defconst Copy-location-user2            (1+ Copy-location-user1))
  (global:defconst Length-user1                   4)
  (global:defconst Length-user2                   (1+ Length-user1))
  ;;these are 32 bit nubus byte addresses
  (global:defconst min-physical-address 6)
  (global:defconst max-physical-address 7)
  (global:defconst physical-address-1 8)
  (global:defconst physical-address-2 (+ physical-address-1 1))
  (global:defconst march-pass-counter 10.)
  (global:defconst halt-page-vadr 11.) ;base virtual address for halt page

  (global:defconst %%copy-offset (byte 12. -1))

  (global:defconst inst-block-size-in-bytes (* 16. 1024.))
  (global:defconst map-page-size-in-bytes 4096.)
)

(defafun march-driver ()
  ;;a0 = 0 means first user function; a0 = 1 means second
move-loop
  (movei a0 0)

select-loop
  ;;select new physical location

  ;;read current phys adr for function
  (movei vma #.physical-address-1)
  (alu add vma a0 vma)				;first or second pass
  (alu l+r vma-start-read-no-transport a15 vma)
  (nop)
  (movei a14 #.(+ inst-block-size-in-bytes 8))	;compute new phys address based on old one
  (alu l+r a14 a14 md)
  (move a13 a14)
  ;;split offset from rest of adr
  (movei a1 #.(- inst-block-size-in-bytes 1))
  (alu and a13 a13 a1)				;tenative offset
  (alu not-r a1 a1 a1)
  (alu and a14 a14 a1)				;tenative base

  ;;see if this is the last page by adding
  ;;the maximum size, and comparing with the max address
  (movei a1 #.inst-block-size-in-bytes)
  (alu add a1 a1 a14)

  (movei vma #.max-physical-address)
  (alu l+r vma-start-read-no-transport a15 vma)
  (nop)

  ;;it's ok for this to be a signed test, since either both addresses will be
  ;;on the nubus (negative) or in local memory (positive)
  (alu l-r nop a1 md)
  (test br-less-than)
  (branch page-ok ())
  
  (movei vma #.min-physical-address)
  (alu l+r vma-start-read-no-transport a15 vma)
  (nop)
  (move a14 md)

page-ok
  (move nop a0)
  (test br-equal)
  (branch page-ok-1 ())
  
  ;;this is the second pass, must not select same page as first pass
  (movei vma #.physical-address-1)
  (alu l+r vma-start-read-no-transport a15 vma)
  (nop)
  (alu l-r nop a14 md)
  (test br-equal)
  (branch select-loop ())			;if collision, just try again

page-ok-1  

  ;;see if the offset is too large, and would cause the function to cross a block boundary
  (movei vma #.length-user1)
  (alu add vma a0 vma)				;first or second pass
  (alu l+r vma-start-read-no-transport a15 vma)
  (nop)
  (move a12 md)
  (alu add a12 a12 a12)				;double to get length in 32 bit words
  ;;a12 is function length in bytes
  (alu add a12 a12 a13)				;add in the tenative offset
  (movei a11 #.inst-block-size-in-bytes)
  (alu l-r nop a12 a11)
  (test br-less-than)
  (branch off-ok ())
  (movei a13 0)
off-ok
  ;;now a14 is address of base of physical page and a13 is offset

  ;;store updated phys adr
  (alu add md a14 a13)				;combine base and offset
  (movei vma #.physical-address-1)
  (alu add vma a0 vma)
  (alu add vma-start-write a15 vma)
  (nop)

  ;;select virtual page
  (movei vma #.Copy-location-user1)
  (alu add vma a0 vma)				;first or second pass
  (alu l+r vma-start-read-no-transport a15 vma)
  (nop)
  (move a12 md)
  (movei a1 #.(lisp:/ inst-block-size-in-bytes 4))
  (alu add a12 a12 a1)
  (test br-not-equal)				;if new page number is zero, then we wrapped, skip to 16'th page
  (branch virt-ok ())
  (movei a12 #.(+ (ash 1 25.) (* 16. 1024.)))
virt-ok
  ;;a12 is base of virtual page to use

  ;;write out target virtual address
  (move md a12)
  (movei vma #.Copy-location-user1)
  (alu add vma a0 vma)
  (alu l+r vma-start-write a15 vma)

  ;;fill in 4 map entries
  ;;read map location zero to get permission bits
  (movei vma 0)
  (nop)
  (nop)
  (nop)
  (movei a11 #xff)
  (alu and a11 a11 memory-map)

  (alu add a10 a14 a11)				;phys base address + permission bits

  (movei a1 #.map-page-size-in-bytes)
  (movei a2 #.(lisp:/ map-page-size-in-bytes 4))

  (move vma a12)				;base virtual page
  (nop) (nop) (nop)
  (move memory-map a10)
  (nop) (nop) (nop)

  (alu add vma a2 vma)				;skip by a map page worth of words
  (alu add a10 a10 a1)				;skip by a map page worth of bytes
  (nop) (nop) (nop)
  (move memory-map a10)
  (nop) (nop) (nop)
 
  (alu add vma a2 vma)				;skip by a map page worth of words
  (alu add a10 a10 a1)				;skip by a map page worth of bytes
  (nop) (nop) (nop)
  (move memory-map a10)
  (nop) (nop) (nop)
 
  (alu add vma a2 vma)				;skip by a map page worth of words
  (alu add a10 a10 a1)				;skip by a map page worth of bytes
  (nop) (nop) (nop)
  (move memory-map a10)
  (nop) (nop) (nop)

  ;;store halts

  (move vma a12)				;base virtual page
  (movei a0 #.(lisp:/ inst-block-size-in-bytes 4))
  (alu add a0 a0 vma)				;end marker
  
  (movei md #xffffffff)				;will act as halt instruction
store-halt-loop
  (move vma-start-write vma)
  (nop)
  (alu r+1 vma ignore vma)
  (alu l-r nop a0 vma)
  (test br-not-equal)
  (branch store-halt-loop ())

  ;;increment a0 and go back for second function
  (move nop a0)
  (test br-not-equal)
  (branch do-relocate ())
  (alu l+1 a0 a0 a0)
  (unconditional-branch select-loop ())

do-relocate
;;;**************************************************
;;;Copy each of the instructions
;;;  Relocate the jump instructions
;;;    scan function looking for conditional jump opcode, add offset to low 12 bits
;;;    also, scan function looking for calls/long jumps to other function and fix them

  (move a14 gr:*zero*)
  (movei a1 '010) 						;;Opcode for Jump or call instruction.
  (movei a13 '#.Virtual-address-original-user1)
User1/2-loop
  (alu   l+r a13 a13 a14 bw-24)        				;;Increment copy-from index for user1 vs user2
  (alu   l+r vma-start-read-no-transport a15 a13 bw-24 unboxed-vma unboxed-md)
  (movei a12 '#.Copy-location-user1)
  (move  a13 md)  						;;Address of copy-from location
  (alu-field field-extract-r a3 ignore a13 (byte 24. -1)) 	;;Turn copy-from Address into PC type
  (alu   l+r a12 a12 a14 bw-24)        				;;Increment copy-to index for user1 vs user2
  (alu   l+r vma-start-read-no-transport a15 a12 bw-24 unboxed-vma unboxed-md)
  (movei a11 '#.Length-user1)
  (move  a12 md)  						;;Addres of copy-to location
  (alu-field field-extract-r a2 ignore a12 (byte 24. -1)) 	;;Turn copy-to address into PC type
  (alu-field field-extract-r a5 ignore a12 %%copy-offset) 	;;Offset within the page we are copying to.
  (alu   l+r a11 a11 a14 bw-24)        				;;Increment lenth index for user1 vs user2
  (alu   l+r vma-start-read-no-transport a15 a11 bw-24 unboxed-vma unboxed-md)
  (move  a10 gr:*zero*)  					;;wait for MD; Zero length counter.
  (move  a4  md)  						;;Length of code to copy
Loop-for-each-instruction 					;;incrementing A10 before repeating
  (alu  l+1 vma-start-read-no-transport a13 ignore unboxed-vma unboxed-md)
  (alu  l+1 a10 a10 ignore bw-24)	  			;;Wait for MD; Increment inst loop counter -- a10
  (move a7 md) 							;;high inst word
  (move vma-start-read-no-transport a13 unboxed-vma unboxed-md) ;;start read of low inst word
  (alu-field field-extract-r a6 ignore a7 (byte 3. -26.)) 	;;Wait for MD; Opcode of high inst -- hw:%%i-op-code-high
  (move a8 md) 							;;low inst word
  (move vma-start-read-will-write a12 unboxed-vma unboxed-md)	;;Set up vma for copy of low inst below
;;; Is it a conditional jump?
  (alu-field aligned-field-xor nop gr:*zero* a6 (byte 2 0)) 	;;low two bits of opcode
  (alu-field field-extract-r nop ignore a7 (byte 2 -24.) br-not-equal) ;; next pc
  (branch maybe-call-or-jump (alu l+2 a13 a13 ignore br-not-equal)) ;;Increment from-address
  (branch copy-it (move md-start-write-no-gc-trap a8))		;;Copy low word inst
;;;We have a Branch inst 					;;or a CALL-Z instruction
  (unconditional-branch copy-it (alu l+r md-start-write-no-gc-trap a8 a5 bw-24));;Assume this does not affect bits above 12th 
Maybe-call-or-jump
  (alu xor nop a1 a6 bw-24)
  (alu l-r a0 a8 a3 bw-24 br-not-equal)				;;Subtract base source address from jump address
  (branch copy-it (move md-start-write-no-gc-trap a8))		;;Copy low word inst
;;;We have a jump or call inst
  (alu l+r md-start-write-no-gc-trap a0 a2 bw-24)		;;Add back base destination address to jump address
Copy-it								;;Low word is already copied.
  (alu l+1 vma-start-read-will-write a12 ignore unboxed-vma unboxed-md)
  (alu l-r nop a10 a4 bw-24)
  (move md-start-write-no-gc-trap a7 br-not-equal)		;;copy high word inst
  (branch Loop-for-each-instruction (alu l+2 a12 a12 ignore bw-24)) ;;Increment To-address
;;;Check for loop again for next piece of code.
  (alu l-1 nop a14 ignore bw-24 boxed)
  (movei a13 '#.Virtual-address-original-user1 br-not-equal)
  (branch User1/2-loop (alu l+1 a14 a14 ignore bw-24 boxed))

;;;**************************************************

  ;;flush icache
  (move a0 processor-control boxed-right)
  (alu-field field-pass processor-control gr:*zero* a0 hw:%%processor-control-icache-enables boxed-right)
  (alu pass-status nop ignore ignore)
  (move processor-control a0 boxed-right)

  (movei vma #.Copy-location-user1)
  (alu add vma-start-read-no-transport a15 vma)
  (alu pass-status nop ignore ignore)
  
  ;;call user program
  ;;convert virtual address to PC (already has 25'th bit set)
  (alu-field field-extract-r a1 ignore md (byte 24. -1))
  (alu pass-status nop ignore ignore)
  (alu pass-status nop ignore ignore ch-open-call next-pc-dispatch)

  ;;increment pass counter
  (movei vma #.march-pass-counter)
  (alu add vma-start-read-no-transport a15 vma)
  (alu pass-status nop ignore ignore)
  
  (alu r+1 md ignore md)
  (move vma-start-write vma)
  (alu pass-status nop ignore ignore)

  ;;unmap user pages
  ;;get map entry for halt page
  (movei vma #.halt-page-vadr)
  (alu pass-status nop ignore ignore)
  (alu pass-status nop ignore ignore)
  (alu pass-status nop ignore ignore)
  (move a1 memory-map)

  (movei a0 0)
  (movei a2 #.(lisp:/ map-page-size-in-bytes 4))
finish-loop
  (movei vma #.Copy-location-user1)
  (alu add vma a0 vma)
  (alu add vma-start-read-no-transport a15 vma)
  (alu pass-status nop ignore ignore)

  (move vma md)
  (alu pass-status nop ignore ignore) (alu pass-status nop ignore ignore) (alu pass-status nop ignore ignore)
  (move memory-map a1)

  (alu add vma a2 vma)
  (alu pass-status nop ignore ignore) (alu pass-status nop ignore ignore) (alu pass-status nop ignore ignore)
  (move memory-map a1)

  (alu add vma a2 vma)
  (alu pass-status nop ignore ignore) (alu pass-status nop ignore ignore) (alu pass-status nop ignore ignore)
  (move memory-map a1)

  (alu add vma a2 vma)
  (alu pass-status nop ignore ignore) (alu pass-status nop ignore ignore) (alu pass-status nop ignore ignore)
  (move memory-map a1)

  (move nop a0)
  (test br-not-equal)
  (unconditional-branch move-loop ())
  (alu l+1 a0 a0 a0)
  (unconditional-branch finish-loop ())
)