// xvm.sr


get "BRAVO1.DF";
get "VM.DF";


// Incoming Procedures

external	[
	ugt
	ult
	errhlta
	ActOnPages
	umin
	augmentomseq
	WritePages
	deactivateomseq
	movec
	hpalloca
	move
	hpfree
	];


// Incoming Statics

external	[
	vcompactlock
	DCwrite
	fillInDA
	eofDA
	DCread
	vpw
	vlb
	vchremain
	vvpargcc1
	vvpargcc2
	];


// Outgoing Procedures

external	[
	getvp;
	puts;
	unlockbp;
	lockbp;
	gets;
	flushfn;
	DirtyBp
	flushvm;
	setmacfp;
	endofs;
	clearbp;
	remakevmtb;
	CbpDirty
	];


// Outgoing Statics

external	[
	dnbp;
	mpfnof;
	vcpput;
	rglastused;
	lrutime;
	vbp;
	rgvpa;
	rgbs;
	vmtb;
	rgbp;
	macbp;
	cvmfree;
	rgnchlast;
	vextendof;
	vchremainput;
	vpwput;
	vlbput;
	];


// Local Statics

static	[
	dnbp;
	mpfnof;
	vcpput;
	rglastused;
	lrutime;
	vbp;
	rgvpa;
	rgbs;
	vmtb;
	rgbp;
	macbp;
	cvmfree;
	rgnchlast;
	vextendof;
	vchremainput;
	vpwput;
	vlbput;

	vwremain;
	vwremainput;
	];


// V M L K U P
// catalogue no. = 60
let vmlkup(vpaddr) = valof
[
let i = ((vpaddr rshift 8)+vpaddr) & vmtbmask;
let f2 = (vpaddr rshift 4) % 1;
	[
// l1010:
	if vmtb ! i eq vpaddr then resultis i;
	if vmtb ! i eq 0 then resultis -1;
	i = (i+f2) & vmtbmask;
	] repeat
]


// V M L K U P I
// catalogue no. = 61
and vmlkupi(vpaddr) = valof
[
let i = ((vpaddr rshift 8)+vpaddr) & vmtbmask;
let f2 = (vpaddr rshift 4) % 1;
	[
// l1020:
	if vmtb ! i eq vpaddr then resultis i;
	if vmtb ! i eq 0 then
		[
		vmtb ! i = vpaddr;
		cvmfree = cvmfree-1;
		resultis i;
		]
	i = (i+f2) & vmtbmask;
	] repeat;
]


// C K V M
// catalogue no. = 62
// and ckvm() be
// [
// ckproc = "ckvm"
// ckperr = -1;
// let tc0s = 0;
// 	[
// 	ckperr = ckperr+1;
// 	test vmtb ! ckperr eq 0 ifso tc0s = tc0s+1
// 	ifnot
// 		[
// 		if ckperr ne vmlkup(vmtb! ckperr) do errhlta(133)
// my add TJM
// 		if vmtb ! ckperr ne rgvpa ! (rgbp ! ckperr) then
// 			errhlta(134);
// 		]
// 	] repeatuntil ckperr eq vmtbmask;
// ?????
// if cvmfree ne tc0s do errck("zc");
// ]


// G E T V P
// catalogue no. = 77
and getvp(vpa) = valof
[
let i = vmlkup(vpa);
lrutime = lrutime+1;
if ugt(lrutime, -4) then
	[
	lrutime = 1;
	for i = 1 to macbp-1 do
		unless rglastused ! i eq -1 then
			rglastused ! i = 0;
	]
test i ge 0 ifso
	[
	vbp = rgbp ! i
	if ult(rglastused ! vbp, lrutime) then
		rglastused ! vbp = lrutime;
	]
ifnot 	[
	vbp = assignbp(vpa);
	diskio(vbp, false);
	]
resultis dnbp ! vbp;
]


// A S S I G N B P

and assignbp(vpa) = valof
[
let tbp = findlru();
if tbp eq -1 then errhlta(135);
clearbp(tbp);
rglastused ! tbp = lrutime;
rgnchlast ! tbp = #1000;
rgvpa ! tbp = vpa;
remakevmtb();
resultis tbp;
]


// F I N D L R U
// catalogue no. = 79
and findlru() = valof
[
let tbpmin = bpbuff;
rglastused ! bpbuff = -1;
for i = 0 to macbp-1 do
	[
	if ult(rglastused ! i, rglastused ! tbpmin)
	  & ((rgbs ! i)<<BS.dirty eq false) then
		tbpmin = i;
	]
if tbpmin eq bpbuff then resultis -1;
resultis tbpmin;
]

// C B P  D I R T Y
// 
and CbpDirty() = valof
[
let cbpDirty = 0;
for i = 0 to macbp-1 do
	[
	if (rgbs ! i)<<BS.dirty then
		cbpDirty = cbpDirty+1;
	]
resultis cbpDirty;
]


// D I S K I O
// catalogue no. = 80
and diskio(bp, wf) be
[
let vpa = rgvpa ! bp;
let fn = vpa<<VPA.fn;
let of = mpfnof ! fn;
let fp = vpa<<VPA.fp+1;
let fpvpa = fp-1;
let rgca = vec maxbp;
rgca ! 0 = dnbp ! vbp;
if vpa<<VPA.fn ge maxfn then errhlta(136);
if (fp+3 ge of>>OF.macfp) & of>>OF.wf then
	[
	setmacfp(fn, fp+4);
	of = mpfnof ! fn;
	]
let rgda = lv(of>>OF.rgda);
let da = (rgda ! fp);
let fileId = lv(of>>OF.fileid);
let fplastda = nil;
let tdc = nil;
(rgbs+bp)>>BS.dirty = false;
test wf ifnot
	[
// 	rglastused ! vbp = -1;
// 	let i = 0;
// 	let tvpa = nil;
// 	let tbp = nil;
// 	let tbplast = vbp;
// 	tvpa<<VPA.fn = fn;
// 	for tfp = fpvpa+1 to fpvpa+vdeltafp-1 do
// 		[
//		tvpa<<VPA.fp = tfp;
// 		if (rgda ! (tfp+1) eq fillInDA) % (rgda ! (tfp+1) eq eofDA) then break;
// 		let j = vmlkup(tvpa);
// 		if j ge 0 then break;
// 		tbp = assignbp(tvpa);
// 		rgca ! (tfp-fpvpa) = dnbp ! tbp;
// 		tbplast = tbp;
// 		i = i+1;
// 		]
	remakevmtb();
	if (da eq fillInDA) % (da eq eofDA) then
		[
// 		unless of>>OF.wf & i eq 0 do errhlta(137);
		unless of>>OF.wf do errhlta(137);
		movec(dnbp ! bp, dnbp ! bp+#377, 0);
		return;
		]
	tdc = DCread;
// 	test (da eq fillInDA) % (da eq eofDA) ifso
// 		[
//		unless of>>OF.wf & i eq 0 do errhlta(137);
// 		movec(dnbp ! bp, dnbp ! bp+#377, 0);
// 		]
// 	ifnot	unless ActOnPages(rgca-fp, rgda, fileId, fp, fp+i, DCread, 0, 0, 0, 0) eq fp+i do
// 		errhlta(138);
// 	lrutime = lrutime+1;
// 	rglastused ! vbp = lrutime;
	]
ifso	[
	unless of>>OF.wf do errhlta(137);
	tdc = DCwrite;
	fplastda = fp;
	while (rgda ! fplastda eq fillInDA) % (rgda ! fplastda eq eofDA) do
		fplastda = fplastda-1;
	if (rgda ! (fp+1) eq fillInDA) % (rgda ! (fp+1) eq eofDA) then
		fplastda = ActOnPages(0, rgda, fileId, fplastda, umin(129, fp+3), DCread, 0, 0, dnbp ! bpbuff, 0);
// 	test (rgda ! (fp+1) eq fillInDA) % (rgda ! (fp+1) eq eofDA) ifnot
// 		ActOnPages(0, rgda, fileId, fp, fp, DCwrite, 0, 0, dnbp ! bp, 0)
	if (rgda ! (fp+1) eq fillInDA) % (rgda ! (fp+1) eq eofDA) then
		[
		let macpos = (mpfnof ! fn)>>OF.macpos;
		let numcharslast = ((fpvpa eq macpos<<PCD.p) ? macpos<<PCD.rc, #1000);
		test (of>>OF.fFullPages) % (numcharslast eq #1000) ifnot
			[
			fplastda = umin(fplastda, fp);
			if ((of>>OF.macpos) rshift 9) ne fp-1 then
				errhlta(139);
// 			WritePages(0, rgda, fileId, fplastda, fp, 0, 0, numcharslast, dnbp ! bp);
			]
		ifso
			[
			fp = fp+1;
			numcharslast = 0;
//			WritePages(0, rgda, fileId, fplastda, fp+1, 0, 0, 0, dnbp ! bp);
			]
		augmentomseq("QT");
		let of = mpfnof ! fn;
		WritePages(0, lv(of>>OF.rgda), lv(of>>OF.fileid), fplastda, fp, 0, 0, numcharslast, dnbp ! bp);
		deactivateomseq("QT", "QT");
		return;
		]
	]
ActOnPages(0, rgda, fileId, fp, fp, tdc, 0, 0, dnbp ! bp, 0);
]


// C L E A R B P
// catalogue no. = 82
and clearbp(bp) be
	if (rgbs+bp)>>BS.dirty then
		diskio(bp, true);


// R E M A K E V M T B
// catalogue no. = SPE-83
and remakevmtb() be
[
for i = 0 to vmtbmask do
	vmtb ! i = 0;
for bp = 0 to macbp-1 do
// were gonna do two things at once; set vmtb and rgbp
	unless rgvpa ! bp eq -1 do
		rgbp ! vmlkupi(rgvpa ! bp) = bp;
]


// R E M O V E B P
// catalogue no. = SPE-86
// and removebp() be
// [
// if macbp le 1 do errhlta(140);
// let tbp = findlru();
// clearbp(tbp);
// hpfree(dnbp ! tbp);
// for i = tbp+1 to macbp-1 do
// 	[
// 	rgvpa ! (i-1) = rgvpa ! i;
// 	dnbp ! ( i-1) = rgvpa ! i;
// 	rglastused ! (i-1) = rglastused ! i;
// 	rgbs ! (i-1) = rgbs ! i;
// 	]
// macbp = macbp-1;
// remakevmtb();
// ]


// G E T S P U T S

and GetsPuts(fn, item, fGets, lvpw, lvlb, lvcwRemain, lvcchRemain) = valof
[
let pos = (mpfnof ! fn)>>OF.pos;
let trc = nil;
let vpa = nil;
let coreaddrpage = nil;
let macpos = (mpfnof ! fn)>>OF.macpos;
if fGets & (not ult(pos, macpos)) then
		errhlta(141)
vpa<<VPA.fn = fn;
vpa<<VPA.fp = pos<<PCD.p;
let bphint = (mpfnof ! fn)>>OF.bphint;
unless vpa eq rgvpa ! bphint then
	[
	test (mpfnof ! fn)>>OF.macfp eq 0 ifnot
		[
		getvp(vpa);
		bphint = vbp;
		]
	ifso
		[
		test fGets ifso
			[
			let i = vmlkup(vpa);
			if i eq -1 then errhlta(142);
			bphint = rgbp ! i;
			]
		ifnot	errhlta(144);
		]
	(mpfnof ! fn)>>OF.bphint = bphint;
	]
coreaddrpage = dnbp ! bphint;
trc = pos<<PCD.rc;
rv lvpw = coreaddrpage+(trc rshift 1);
let trcRemain = #1000-trc;
let twGet = rv (rv lvpw);
let tdfc = nil;
test fGets ifso
	trcRemain = umin(trcRemain, macpos-pos)
ifnot
	[
	(rgbs+bphint)>>BS.dirty = true;
	unless (mpfnof ! fn)>>OF.wf do errhlta(145);
	]
let titem = nil;
test (mpfnof ! fn)>>OF.wmode ifso
	[
	if pos<<odd then errhlta(143);
	rv lvcwRemain = trcRemain rshift 1;
	unless fGets then
		(rv (rv lvpw)) = item;
	tdfc = 2;
	titem = twGet;
	]
ifnot	[
	rv lvcchRemain = trcRemain;
	rv lvlb = trc<<odd ? false, true;
	tdfc = 1;
	test (rv lvlb) ifso
		[
		unless fGets then
			(rv lvpw)>>lh = item
		titem = (rv lvpw)>>lh
		]
	ifnot
		[
		unless fGets then
			(rv lvpw)>>rh = item
		titem = (rv lvpw)>>rh;
		]
	]
(mpfnof ! fn)>>OF.pos = pos+tdfc;
unless fGets then
	unless ult(pos, macpos) do
		test pos eq macpos ifso
			[
			(mpfnof ! fn)>>OF.macpos = macpos+tdfc
			rgnchlast ! bphint = trc+tdfc;
			]
		ifnot	errhlta(147);
resultis titem
]


// G E T

and gets(fn) = GetsPuts(fn, 0, true, lv vpw, lv vlb, lv vwremain, lv vchremain);
// and gets(fn) = valof
// [
// let pos = (mpfnof ! fn)>>OF.pos;
// let trc = nil;
// let vpa = nil;
// let coreaddrpage = nil;
// unless ult(pos, (mpfnof ! fn)>>OF.macpos) then
// 	errhlta(141);
// vpa<<VPA.fn = fn;
// vpa<<VPA.fp = pos<<PCD.p;
// let bphint = (mpfnof ! fn)>>OF.bphint;
// unless vpa eq rgvpa ! bphint then
// 	test (mpfnof ! fn)>>OF.macfp eq 0 ifnot
// 		[
//		getvp(vpa);
// 		(mpfnof ! fn)>>OF.bphint = vbp;
// 		bphint = vbp;
// 		]
// 	ifso	[
//		let i = vmlkup(vpa);
// 		if i eq -1 then errhlta(142);
// 		bphint = rgbp ! i;
// 		(mpfnof ! fn)>>OF.bphint = bphint;
// 		]
// coreaddrpage = dnbp ! bphint;
// trc = pos<<PCD.rc;
// vpw = coreaddrpage+(trc rshift 1);
// test (mpfnof ! fn)>>OF.wmode ifso
// 	[
//	if pos<<odd then errhlta(143);
// 	vwremain = umin(((mpfnof ! fn)>>OF.macpos)-pos, #400-(vpw-coreaddrpage));
// 	(mpfnof ! fn)>>OF.pos = pos+2;
// 	resultis rv vpw;
// 	]
// ifnot	[
//	vchremain = umin(((mpfnof ! fn)>>OF.macpos)-pos, #1000-trc);
// 	vlb = trc<<odd ? false, true;
// 	(mpfnof ! fn)>>OF.pos = pos+1;
// 	test vlb ifso
// 		resultis vpw>>lh
// 	ifnot	resultis vpw>>rh;
// 	]
// ]


// P U T

and puts(fn, item) be
[
GetsPuts(fn, item, false, lv vpwput, lv vlbput, lv vwremainput, lv vchremainput);
]
// [
// let pos = (mpfnof ! fn)>>OF.pos;
// let trc = nil;
// let vpa = nil;
// let coreaddrpage = nil;
// let macpos = (mpfnof ! fn)>>OF.macpos;
// vpa<<VPA.fn = fn;
// vpa<<VPA.fp = pos<<PCD.p;
// let bphint = (mpfnof ! fn)>>OF.bphint;
// unless vpa eq rgvpa ! bphint then
// 	[
//	test (mpfnof ! fn )>>OF.macfp eq 0 ifso
// 		errhlta(144)
// 	ifnot	[
//		getvp(vpa);
// 		bphint = vbp;
// 		]
// 	(mpfnof ! fn)>>OF.bphint = bphint;
// 	]
// coreaddrpage = dnbp ! bphint;
// trc = pos<<PCD.rc;
// (rgbs+bphint)>>BS.dirty = true;
// unless (mpfnof ! fn)>>OF.wf do errhlta(145);
// vpwput = coreaddrpage+(trc rshift 1);
// test (mpfnof ! fn)>>OF.wmode ifso
// 	[
//	if pos<<odd then errhlta(146);
// 	rv vpwput = item
// 	vwremainput = #400-(vpwput-coreaddrpage);
// 	unless ult(pos, macpos) do
// 		test pos eq macpos ifso
// 			[
//			(mpfnof ! fn)>>OF.macpos = macpos+2
// 			rgnchlast ! bphint = (macpos<<PCD.rc)+2;
// 			]
// 		ifnot	errhlta(147);
// 	(mpfnof ! fn)>>OF.pos = pos+2;
// 	]
// ifnot	[
//	vlbput = trc<<odd ? false, true;
// 	test vlbput ifso
// 		vpwput>>lh = item
// 	ifnot	vpwput>>rh = item
// 	vchremainput = #1000-trc;
// 	unless ult(pos, macpos) do
// 		test pos eq macpos ifso
// 			[
//			(mpfnof ! fn)>>OF.macpos = macpos+1
// 			rgnchlast ! bphint = (macpos<<PCD.rc)+1;
// 			]
// 		ifnot	errhlta(148);
// 	(mpfnof ! fn)>>OF.pos = pos+1;
// 	]
// ]


// F L U S H F N

and flushfn(fn) be
[
// bpbuff better equal 0!!
for bp = bpbuff+1 to macbp-1 do
	if (rgvpa ! bp)<<VPA.fn eq fn then
		clearbp(bp);
]


// L O C K B P

and lockbp(bp) be
	rglastused ! bp = -1;


// U N L O C K B P

and unlockbp(bp, dirty) be
[
rglastused ! bp = lrutime;
(rgbs ! bp)<<BS.dirty = ((rgbs ! bp)<<BS.dirty) % dirty;
]


// S E T M A C F P

and setmacfp(fn, newmac) be
[
let of = mpfnof ! fn;
let macfp = of>>OF.macfp;
if macfp eq 0 then errhlta(151);
let ofnew = hpalloca(ofsiz+newmac);
of = mpfnof ! fn;
move(of, ofnew, ofsiz+umin(macfp, newmac));
let rgdanew = lv(ofnew>>OF.rgda);
if newmac gr macfp then
	movec(rgdanew+macfp, rgdanew+newmac, fillInDA);
ofnew>>OF.macfp = newmac;
mpfnof ! fn = ofnew;
hpfree(of);
]


// E N D O F S

and endofs(fn) = valof
[
let of = mpfnof ! fn;
test ult(of>>OF.pos, of>>OF.macpos) ifso
	resultis false
ifnot	resultis true;
]


// S E T M A C P O S
// 
// and setmacpos(fn, newmacpos) be
// [
// let newmacfp = newmacpos<<PCD.p;
// if newmacfp gr (mpfnof ! fn)>>OF.macfp then
// 	setmacfp(fn, newmacfp+3);
// let vpa = nil;
// vpa<<VPA.fn = fn;
// vpa<<VPA.fp = newmacfp;
// let i = vmlkup(vpa);
// if i ne -1 then
// 	rgnchlast ! (rgbp ! i) = newmacpos<<PCD.rc;
// (mpfnof ! fn)>>OF.macpos = newmacpos;
// ]


// F L U S H V M

and flushvm() be
[
for bp = 0 to macbp-1 do
	[
	clearbp(bp);
	unlockbp(bp, false);
	]
vvpargcc1 = -1;
vvpargcc2 = -1;
]


// D I R T Y B P

and DirtyBp(bp) be (rgbs ! bp)<<BS.dirty = true

z20602(2117)