// VMemB.bcpl. D* virtual memory package
// Last modified March 19, 1985  6:38 PM by Bill van Melle
// Last modified December 13, 1984  11:50 AM by Bill van Melle
// Gutted November 19, 1984  5:34 PM by Bill van Melle
// Last modified May 25, 1983  10:58 AM by Bill van Melle
// Last modified March 14, 1983  5:31 PM by Bill van Melle
// Last modified February 4, 1983  10:33 PM by Bill van Melle
// Major pruning December 16, 1982  10:27 PM by Bill van Melle
// Last modified May 17, 1982  1:58 PM by Bill van Melle

	get "LispBcpl.decl"
	get "Stats.decl"
	get "VMem.decl"
	get "Streams.d"

external	// SUBRS
 [ PageFault		// (lvPtr)

   MOREVMEMFILE		// (filepage)
   WRITEMAPSUBR		// (vp rp flags)
   LISPFINISH		// () returns to Alto exec

		// other entries
   IGetBase		// (offset)
   IPutBase		// (offset, val)
   LookupPage		// (vp)
   RemapMemory		// () cleans up on exit
   WriteSwapBuf		// () writes any dirty page out to vmem
  ]

external [		// OS procedures
	CallSwat; Zero
			// fpr LISPFINISH:
	CreateDiskStream; PositionPage; FileLength; ReadBlock; Closes
			// Other procs used
	LispCleanup; LoadRam; Fault; MachineType; DeImplementedSubr

	BP; VP; VP2
	IndexedPageIO; SmallUnbox
	@BGetBase; @BPutBase; MkSmallPos; EqNIL; EmUnbox
			// Raid procs
	Ws; Wo; RaidReset; PrintPtr; RAIDCode

			// Statics
	realPageTableSetup; memAvailTable; FirstRealPageNo	// exported
	noFaultFlg; SwapBuf; SwapBufVp; SwapBufFileP; SwapBufDirty
	lvAbortFlag	// OS
	LispFmap; @RMSK
	@lvNIL; @lvKT; @MiscSTATSbase
	insideRaid; EmulatorSpace
	LastRealPageNo
			// fpr LISPFINISH:
	PupZoneStart; PupZoneLength; altoUcodeFp; uCodeLoaded


			// Other external VMem procs (from VmemA.asm)
	ReadFlags	// (VP) -> oldflags
	ReadRP		// (VP) -> RP
	SetFlags	// (VP, RP, flags)
	]

static
 [ @Bpt; @BptSegment; BptSize; @BufVp; @BufRP
   @RPoffset; LispFmap
   realPageTableSetup = false
   memAvailTable
   FirstRealPageNo

   SwapBuf
   SwapBufVp = 0
   SwapBufFileP = 0
   SwapBufDirty = false
 ]


let PageFault(lvPtr, ac2) = valof		// page fault handler
 [
 let vp = VP(lvPtr)
 if vp ne SwapBufVp
   then	[
	let flags = ReadFlags(vp)
	test (flags & VACANT) ne VACANT
	   ifso resultis RAIDCode("Fault on resident page", lvPtr, true)
	  ifnot [
		let filep = LookupPage(vp)
		test filep
		   ifso [
			if not insideRaid
			   then RAIDCode("Non-Raid fault inside Bcpl.  ↑N to continue", lvPtr)
			if vp ne SwapBufVp
			   then ReadSwapBuf(vp, filep)
			]
		   ifnot InvalidAddr (lvPtr)
		]
	]
 if (@ac2)!2 gr Fault
    then SwapBufDirty = true	// write fault
 ac2!4 = EmulatorSpace
			 // adjust reference to point at core buffer
 ac2!5 = ((ac2!5) & RMSK) + SwapBuf
 resultis lvPtr
 ]

and ReadSwapBuf(vp, filep) be
 [
 if SwapBufDirty then WriteSwapBuf()
 IndexedPageIO(LispFmap, filep, SwapBuf, 1, false)
 SwapBufVp = vp
 SwapBufFileP = filep
 SwapBufDirty = false
 ]

and WriteSwapBuf() be
 [
 if SwapBufDirty then IndexedPageIO(LispFmap, SwapBufFileP, SwapBuf, 1, true)
 SwapBufDirty = false
 ]

and InvalidAddr (lvPtr) be
   [
   if insideRaid
      then [ Ws ("Invalid address: ")
	     PrintPtr (lvPtr!0, lvPtr!1)
	     RaidReset()
	   ]
   RAIDCode("Invalid address", lvPtr, true)
   ] repeat



and LookupPage(vp) = valof
 [		// Returns page in vmem file or 0 if the page does not exist
   compileif (not BigAddressSpace)
      then [   if (vp&#140000) ne 0 then InvalidVP(vp)  ]
   let pmpE = BGetBase(PMTspace, PMTbase + vp<<PVP.key1)
   if pmpE eq -1 then resultis 0
   let px = PAGEMAPbase + pmpE + vp<<PVP.key2
   resultis BGetBase(PAGEMAPspace, px)
 ]


and IGetBase(disp) = BGetBase(INTERFACEspace,INTERFACEbase+disp)

and IPutBase(disp,val) be BPutBase(INTERFACEspace,INTERFACEbase+disp,val)

and InvalidVP(vp) be 
   [
   if insideRaid
      then [ Ws ("Invalid VP: ")
	     Wo(vp, true)
	     RaidReset()
	   ]
   RAIDCode("Invalid VP", MkSmallPos(vp))
   ] repeat

and LISPFINISH() be 
  [
  LispCleanup()
  if altoUcodeFp & uCodeLoaded
     then [		// reload alto microcode
	let s = CreateDiskStream(altoUcodeFp, ksTypeReadOnly, wordItem)
	altoUcodeFp = 0
	unless s do finish
	let sl = (FileLength(s) + 1) rshift 1 - WordsPerPage
					// length of LoadRam buffer we need
	let buffer = ((PupZoneStart+PupZoneLength) + WordsPerPage-1) & not (WordsPerPage-1)
	PositionPage(s, 2)
	ReadBlock(s, buffer, sl)
	Closes(s)
	LoadRam((MachineType() eq Dolphin? buffer-1, buffer), 1)
	  ]
  finish
  ]

and RemapMemory() be
  [		// restore map to virgin state on exit
  unless realPageTableSetup do return
// I hope the emulator pages are ok, because we don't have a table for them

  let firstvp = VP2((EmulatorSpace eq 0? 1, 0), 0)	// first non-emulator page
  let rp = FirstRealPageNo
  let lastvp = MachineType() eq Dorado? #177777, #37777

  let vp = firstvp-1
  [ vp = vp + 1
    SetFlags (vp, 0, VACANT)	// unmap everything
  ] repeatuntil vp eq lastvp

  let bitBase = memAvailTable + (rp rshift 4)
  let lastBitBase = memAvailTable + ((LastRealPageNo-1) rshift 4)
  vp = firstvp
  for base = bitBase to lastBitBase
    do	[
	let info = @base
	for i = 0 to 15
	   do	[
		if (info&1) eq 1
		   then [
			SetFlags(vp, rp, 0)	// map this vp into this page
			vp = vp+1
			]
		info = info rshift 1
		rp = rp+1
		]
	]
  ]

and WRITEMAPSUBR (vp, rp, flags) = valof
  [
  SetFlags (SmallUnbox(vp), SmallUnbox(rp), SmallUnbox(flags))
  resultis vp
  ]

and MOREVMEMFILE (filepage) = DeImplementedSubr()