// VMemExtra.bcpl. virtual memory package debugging
// Last modified May 25, 1983  11:21 AM by Bill van Melle
// Last modified June 25, 1982  2:42 PM by Bill van Melle
// Last modified March 29, 1982  2:56 PM by Bill van Melle

	get "LispBcpl.decl"
	get "Stats.decl"
	get "VMem.decl"

external [		// defined here
	CheckMap; MapCheck1; MapCheck2; PrintPageTable
			// OS procedures
	Endofs; Gets; Resets
	Random
			// Other procs used
	BP; VP; VP2; Bytes2; MkSmallPos
			// Raid procs
	Ws; Wo; Wn; Wc; CRLF; RaidReset; PrintPtr; RAIDCode; GetFXP

			// Statics
	keys
	@lvNIL; @lvKT
	insideRaid; EmulatorSpace; LastRealPageNo
	crCount; @RMSK


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



let CheckMap() be
  [ 
  Ws (" for ")
  switchon Gets(keys) into
	[
	case $C: case $c:
		[
		Ws ("Consistency*N")
		MapCheck0()
		return
		]
	case $R: case $r:
		[
		Ws ("at Random*N")
		MapCheck2()
		return
		]
	case $S: case $s:
		[
		Ws ("Swap buffer*N")
		MapCheck1()
		return
		]
	case $?:[
		Ws ("*NConsistency, Swapbuffer, Random*N  Check Map")
		endcase
		]
	default:  Ws ("??")
		Resets(keys)
	]
  ] repeat

and MapCheck0() be
  [
	let errorcnt = 0
			// first test that every vp in Bpt maps to the
			// real page we think it does
	for i = 1 to BptSize-1
	     do [
		let bp = BP(i)		// entry in Bpt
		if bp>>BPT.STATE ls EMPTY
		   then [
			let rp = ReadRP (bp>>BPT.VP)
			if rp ne (i + RPoffset)
			   then [
				MapError (bp>>BPT.VP, i+RPoffset, rp)
				errorcnt = errorcnt+1
				]
			]
		]

			// now for all 2↑14 virtual pages, check that those
			// that are non-vacant map to what we say they do

	for seg = 0 to LastVirtualPage<<VP.segment
	   do test seg eq EmulatorSpace
		ifso for p = 0 to PagesPerSegment-1
		     do [		// emulator pages are not in Bpt,
					// but implicitly map to self
			let vp = Bytes2 (EmulatorSpace, p)
			test (ReadFlags (vp) & VACANT) eq VACANT
			   ifso [ CRLF()
				Ws ("Error: Emulator page ")
				Wo (p)
				Ws (" is marked vacant")
				errorcnt = errorcnt+1
				]
			  ifnot [
				let rp = ReadRP (vp)
				let myrp = p + RPoffset - (PagesPerSegment-1)
			// because RPoffset = realpage0+PagesPerSegment-1
				if rp ne myrp
				   then [
					MapError (vp, myrp, rp)
					errorcnt = errorcnt+1
					]
				]
			]
		ifnot for p = 0 to PagesPerSegment-1
		     do [
			let vp = Bytes2(seg, p)
			let flags = ReadFlags (vp)
			if (ReadFlags (vp) & VACANT) ne VACANT
			   then [ let rp = ReadRP(vp)
				let bp = BP(rp-RPoffset)
				if bp>>BPT.VP ne vp
				   then [
					MapError2 (vp, rp, bp>>BPT.VP)
					errorcnt = errorcnt+1
					]
				]
			]

	CRLF()
	Wn (errorcnt, 10)
	Ws (" errors detected")
	CRLF()
  ]

and MapError (vp, myrp, maprp) be
  [
  CRLF()
  Ws ("Error for virtual page ")
  Wo (vp); CRLF()
  Ws ("  Fault software says real page = ")
  Wo (myrp)
  Ws (", hardware map says ")
  Wo (maprp)
  ]

and MapError2 (vp, maprp, myvp) be
  [
  CRLF()
  Ws ("Error for virtual page ")
  Wo (vp); CRLF()
  Ws ("  Hardware says real page = ")
  Wo (maprp)
  Ws (", software map says that page")
  test myvp ls LastVirtualPage
    ifso [ Ws (" belongs to vp "); Wo (myvp) ]
    ifnot  Ws ( myvp eq (EMPTY lshift 8) ? " is empty",
		myvp eq (UNAVAIL lshift 8) ? " is unavailable",
						" is confused")
  ]

and MapCheck1 () be
[
Ws ("*NTesting MAP for swap buffer page")
let thous = 0
let NErrors = 0
[
for J = 1 to 10
   do	[
	for I = 1 to 1000
	   do	[
		let rp = Random() & #7777
		SetFlags(BufVp, rp, OCCUPIED)
		let newrp = ReadRP(BufVp)
		if newrp ne rp
		   then [ CRLF(); Ws ("Wrote "); Wo(rp)
			  Ws (", read "); Wo(newrp); NErrors = NErrors+1 ]
		]
	Ws(".")
	]
thous = thous+1
crCount = 1			// inhibit scroll holding
Wn (thous, 10)
if NErrors
   then [ Ws("!"); Wn(NErrors, 10) ]
] repeatwhile (Endofs(keys)) % (Gets(keys) eq #40)
			// do until keyboard input, not space
SetFlags(BufVp, BufRP, OCCUPIED)
CRLF()
Wn (NErrors)
Ws (" errors detected")
CRLF()
]

and MapCheck2 () be
[
Ws ("*NTesting MAP at random")
let thous = 0
let NErrors = 0
[
for J = 1 to 10
   do	[
	for I = 1 to 1000
	   do	[
		let vp = Random() & #37777
		if ((vp rshift 8) eq EmulatorSpace) & (vp ne BufVp)
		   then loop	// don't remap emulator pages: could kill us
		let oldrp = ReadRP(vp)
		let oldflags = ReadFlags(vp)
		let rp = Random() & #7777
		SetFlags(vp, rp, OCCUPIED)
		let newrp = ReadRP(vp)
		if newrp ne rp
		   then [ Ws ("*NWrote "); Wo(rp)
			  Ws (", read "); Wo(newrp); NErrors = NErrors+1 ]
		SetFlags (vp, oldrp, oldflags)
		]
	Ws(".")
	]
crCount = 1			// inhibit scroll holding
thous = thous+1
Wn (thous, 10)
if NErrors
   then [ Ws("!"); Wn(NErrors, 10) ]
] repeatwhile (Endofs(keys)) % (Gets(keys) eq #40)
			// do until keyboard input, not space

CRLF()
Wn (NErrors)
Ws (" errors detected")
CRLF()
]

and PrintPageTable() be
[
let oldstate, start = 0, 0
let n = RPoffset
let bp = Bpt				// start of page table: dummy entry
Ws ("Real pg  virtual page    flags")
CRLF()
   [
	n = n+1
	bp = bp+3			// 3 words per entry
	let state = bp>>BPT.STATE
	if oldstate & ((state ne oldstate) % (n ge LastRealPageNo))
	   then	[
		Wo (start)		// show range of pages
		if start ne n-1
		   then [ Ws(" thru "); Wo(n-1) ]
		Ws (oldstate eq EMPTY? " empty", " unavailable")
		CRLF()
		oldstate, start = 0, 0
		]
	if n ge LastRealPageNo
	   then break
	test state ge EMPTY
	   ifso [			// no vp here, collapse maybe
		if oldstate eq 0
		   then [ oldstate = state; start = n ]
		]
	  ifnot [
		Wo(n); Wc($*S)
		let vp = bp>>BPT.VP
		Wo(vp); Ws (" (");
		Wo(vp rshift 8, true); Wc($,)	// translate to seg, page#
		Wo(vp & RMSK, true); Ws (") "); Wc(9)
		if bp>>BPT.LOCK
		   then Ws (" locked")
		let flags = ReadFlags(vp)
		if (flags & REFbit) ne 0
		   then Ws (" ref")
		if (flags & DIRTYbit) ne 0
		   then Ws (" dirty")
		CRLF()
		]
    ] repeat
]