//D0vm.bcpl
//	Procedures to manage the virtual memory on the record file and
//	the FastSearch procedure called by SearchBlocks.
//	Last edited: 29 November 1979

//VM mapping information is stored in two arrays broken into #2000-word
//chunks stored on the record file.  VAmem[VA] contains all information
//about that VA (presently its AA and "Emulator" bit). AAmem[AA] contains
//the top 7 bits of VA (or #377 if no corresponding VA), allowing
//information for an AA to be determined by indexing into AAmem, then
//searching at most 128 entries in VAmem.  AA and VA buffers compete for
//core storage with the symbol buffers managed by MSYM and MSYMOV.

//All in core blocks are kept in BlockTable, described by the BT structure,
//which has Dirty, Core, and Kind fields.  The Sym, VA, and AA
//structures also have auxiliary tables (HeadBlock, VAtab, and AAtab,
//respectively) that give the BlockAddr in the record file associated
//with that block.

get "mcommon.d"
get "d0.d"
manifest [ get "d0regmem.d" ]

external [
// OS
	SetBlock; Usc

// MIDAS
	MidasSwat

// MSYM
	GetBlock

// MSYMOV
	MakeNewBlock

// MMPRGN
	UpdateMPDValues

// MCMD
	FormCmdMenu

// D0TABLES
	@MEMLEN; @MEMNAM

// Defined here
	LookUpAA; LookUpVA; ChangeVMBrkp; SetVirtP; RetrieveBlock; FastSearch
	@VirtualP; VAtab; AAtab; IMstab; RMstab
]

static [
	VAtab; AAtab; @VirtualP; IMstab; RMstab
]

//Called both as an action and from D1Reset, D1Load, and D1I2.
let SetVirtP(Flag,nil,nil; numargs NA) be
[	VirtualP = Flag
	if NA ge 2 do
	[ UpdateMPDValues(); FormCmdMenu()
	]
]


and RetrieveBlock(TablePtr,Kind,Strategy,Block,InitVal; numargs NA) = valof
[	let Blk = nil
	if NA < 4 then Block = 0
	test TablePtr!0 eq 0
	ifso		//If block doesn't exist
	[ if NA < 5 then resultis 0	//No such Block
	  let B = MakeNewBlock(NPagesPerStandardBlock,Kind,Strategy,Block)
	  TablePtr!0 = B>>BT.BlockAddr
	  Blk = B>>BT.Core
	  SetBlock(Blk,InitVal,BlockSize)
	]
	ifnot Blk = (GetBlock(TablePtr!0,Kind,Strategy,Block))>>BT.Core
	resultis Blk
]


//Note: An AA may be a 16-bit quantity, in which case bits larger than
//the quantity of physical storage are thrown away by the hardware.
//Consequently, before transforming an AA into a VA, unused high-order
//bits are truncated.  However, a VA of -1 is used to represent
//not-in-VM, so not thrown away.

//Return the VA corresponding to AA (return negative if none); if the
//lvPtr arg is provided, point this at the AA structure in core (only do
//this if there is some VA corresponding to AA).
and LookUpVA(AA,lvPtr; numargs NA) = valof
[	AA = AA & (MEMLEN!(IMXx+IMXx+1)-1)
	let Block = RetrieveBlock(AAtab+(AA rshift BlockShift),AAKind,4)
	if Block eq 0 then resultis -1
	let AAPtr = Block+(AA & BlockMask)
	if NA ge 2 then rv lvPtr = AAPtr
	if AAPtr>>IMV.Undef ne 0 then resultis -1
	resultis AAPtr>>IMV.Addr
]


//Return the AA corresponding to VA; if the DVec argument is given, supply
//full particulars in DVec in IM format.  Returns negative if not in VM.
and LookUpAA(VA,DVec; numargs NA) = valof
[	let Val = #17777	//#1 in Undef bit, #7777 in Addr
	if Usc(VA,MEMLEN!(IMx+IMx+1)) < 0 do
	[ let Block = RetrieveBlock(VAtab+(VA rshift BlockShift),VAKind,1)
	  if Block ne 0 then Val = Block!(VA & BlockMask)
	]
	if NA ge 2 then DVec!3 = Val
	resultis Val<<IMV.Undef ne 0 ? -1,Val<<IMV.Addr
]


//Change brkp bits in VA and AA table entries; VA is -1 if not-in-VM,
//in which case no action.  P is false to remove brkp, true to insert.
and ChangeVMBrkp(VA,P) be
[	if VA ge 0 do	//VA < 0 if not in VM
	[ let Block = RetrieveBlock(VAtab+(VA rshift BlockShift),VAKind,1)
	  if Block eq 0 then MidasSwat(NonXVABlock)
	  let Ptr = Block+(VA & BlockMask)
	  Ptr>>IMV.Brkp = P
	  let AA = Ptr>>IMV.Addr
	  Block = RetrieveBlock(AAtab+(AA rshift BlockShift),AAKind,4)
	  if Block eq 0 then MidasSwat(NonXAABlock)
	  (Block+(AA & BlockMask))>>IMV.Brkp = P
	]
]

//Called from SearchBlocks in MSYM.  Returns BlockTable pointer for the
//block containing the nearest symbol le Addr in MemX, or 0 if don't know.
and FastSearch(Addr,MemX) = valof
[	let Block = 0
	switchon MemX into
	[
case IMx: Block = RetrieveBlock(IMstab+
	    ((Addr & (MEMLEN!(IMXx+IMXx+1)-1)) rshift (BlockShift+1)),
		IMKind,1)
	  Addr = Addr & (BlockMask+BlockMask+1); endcase
case RMx: Block = RMstab; endcase
default:  resultis 0
	]
	if (Addr ge MEMLEN!(MemX+MemX+1)) % (Block eq 0) then resultis 0
	resultis GetBlock(Block>>Bytes.Byte↑Addr,SymKind,1,Block)
]