// GVM.SR	** Allowance for eof vecs

get "BRAVO.DF";
// Incoming Procedures

external [
	errck;
	POSITIONPAGE;
	errhlt;
	WRITEVEC;
	READVEC;
	hpfree;
	ugt;
	ult;
	ActOnPages;
	movec;
	umin;
	WritePages;
	opennew;
	dirlkup;
	DeletePages;
	setmacfp;
	];

// Incoming Statics

external [
	ckproc;
	ckperr;
	vpw;
	vlb;
	vchremain;
	dnfn;
	fillInDA;
	eofDA;
	DCwrite;
	DCread;
	vdeltafp;
	];

// Outgoing Procedures

external [
	vmlkup;
	vmlkupi;
	ckvm;
	getvp;
	findlru;
	diskio;
	clearbp;
	remakevmtb;
	addbp;
	removebp;
	gets;
	puts;
	flushfn;
	diskwritegroup;
	trims;
	];

// Outgoing Statics

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

// Local Statics

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

// V M 
//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 errck("PO")
		]
	] 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;
	movec(rglastused,rglastused+maxbp-1,0);
	] 
test i ge 0 ifso
	[ vbp = rgbp ! i
	rglastused ! vbp = lrutime;
	] 
ifnot 	[ vbp = findlru( );
	clearbp(vbp);
	rgvpa ! vbp = vpa;
	diskio(vbp,false);
	] 
resultis dnbp ! vbp;
] 

// 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) then
		tbpmin = i;
	] 
if tbpmin eq bpbuff then resultis -1;
resultis tbpmin;
]
// 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 errhlt("mfn");
if (fp+1 ge of >> OF.macfp) & of >> OF.wf then
// **	[ if (fn ne fndir) % (fp ne of >> OF.macfp-1) then
	[ if ((fn ne fndir) & (fn ne fnput)) % // ** for eof vecs
	    (fp ne of >> OF.macfp-1) then
		errhlt("mfp");
	setmacfp(fn,fp+2);
	of = mpfnof ! fn;
	] 
let rgda = lv(of >> OF.rgda);
let da = (rgda ! fp);
let fileId = lv(of >> OF.fileid);
let fplastda = nil;
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 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 = findlru();
		if tbp ls 0 then break;
		if (rgbs+tbp) >> BS.dirty then
			clearbp(tbp);
		rgvpa ! tbp = tvpa;
		rglastused ! tbp = lrutime;
		rgca ! (tfp-fpvpa) = dnbp ! tbp;
		rgnchlast ! tbp = #1000;
		tbplast = tbp;
		i = i+1;
		] 
	test (da eq fillInDA) % (da eq eofDA) ifso
		[ unless of >> OF.wf % i ne 0 do errhlt("wfe");
		movec(dnbp ! bp,dnbp ! bp+#377,0);
		rgnchlast ! bp = #1000;
		] 
	ifnot	unless ActOnPages(rgca-fp,rgda,fileId,fp,fp+i,DCread,rgnchlast+tbplast,0,0,0) eq fp+i do
		errhlt("nlp");
	remakevmtb();
	lrutime = lrutime+1;
	rglastused ! vbp = lrutime;
	] 
ifso	[
	unless of >> OF.wf do errhlt("wfe");
	test (rgda ! (fp+1) eq fillInDA) % (rgda ! (fp+1) eq eofDA)
	ifnot	test fn eq fnput // **
		ifso WritePages(0,rgda,fileId,fp,fp,
				0,0,rgnchlast ! bp,dnbp ! bp)
		ifnot ActOnPages(0,rgda,fileId,fp,fp,
				DCwrite,0,0,dnbp ! bp,0)
	ifso	[
		fplastda = fp;
		while (rgda ! fplastda eq fillInDA) %
		    (rgda ! fplastda eq eofDA) do
			fplastda = fplastda-1;
		fplastda = ActOnPages(0,rgda,fileId,
			fplastda,umin(129,fp+3),
			DCread,0,0,dnbp ! bpbuff,0);
		test rgnchlast ! bp eq #1000 ifnot
			[
			fplastda = umin(fplastda,fp);
			WritePages(0,rgda,fileId,fplastda,fp,
				0,0,rgnchlast ! bp,dnbp ! bp);
			] 
		ifso	test (rgda ! (fp+1) eq fillInDA) %
				(rgda ! (fp+1) eq eofDA)
			ifso WritePages(0,rgda,fileId,
				fplastda,fp+1,0,0,0,dnbp ! bp);
			ifnot	test fn eq fnput // **
				ifso WritePages(0,rgda,fileId,
					fp,fp,0,0,
					rgnchlast ! bp,dnbp ! bp)
				ifnot ActOnPages(0,rgda,fileId,
					fp,fp,DCwrite,0,0,
					dnbp ! bp,0)
		] 
	] 
(rgbs+bp) >> BS.dirty = false;
] 
// 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;
] 
 

// A D D B P 
// catalogue no. = SPE-85
and addbp(alloc) = valof
[ if macbp eq maxbp then resultis false;
dnbp ! macbp = alloc(chperpage rshift 1);
rglastused ! macbp = 1;
rgvpa ! macbp = -1;
rgbs ! macbp = 0;
macbp = macbp+1;
resultis true;
] 

// R E M O V E B P 
// catalogue no. = SPE-86
and removebp( ) be 
[ if macbp le 1 do errhlt("bpu");
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
//
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
	errhlt("pos");
vpa << VPA.fn = fn;
vpa << VPA.fp = pos << PCD.p;
let bphint = (mpfnof ! fn) >> OF.bphint;
unless vpa eq rgvpa ! bphint then
	[ getvp(vpa);
	(mpfnof ! fn) >> OF.bphint = vbp;
	bphint = vbp;
	] 
coreaddrpage = dnbp ! bphint;
trc = pos << PCD.rc;
vpw = coreaddrpage+(trc rshift 1);
test (mpfnof ! fn) >> OF.wmode ifso
	[ if pos << odd then errhlt("odd");
	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
[ 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
	[ getvp(vpa);
	(mpfnof ! fn) >> OF.bphint = vbp;
	bphint = vbp;
	] 
coreaddrpage = dnbp ! bphint;
trc = pos << PCD.rc;
(rgbs+bphint) >> BS.dirty = true;
unless (mpfnof ! fn) >> OF.wf do errhlt("wf");
vpwput = coreaddrpage+(trc rshift 1);
test (mpfnof ! fn) >> OF.wmode ifso
	[ if pos << odd then errhlt("odd");
	rv vpwput = item
	vwremainput = #400-(vpwput-coreaddrpage);
	unless ult(pos,macpos) do
		test pos eq macpos % pos eq macpos+1
		ifso
			[ (mpfnof ! fn) >> OF.macpos = pos+2
			rgnchlast ! bphint = (macpos << PCD.rc)+2;
			] 
		ifnot	errhlt("mpw");
	(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	errhlt("mpb");
	(mpfnof ! fn) >> OF.pos = pos+1;
	] 
] 

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

// D I S K W R I T E G R O U P
//
and diskwritegroup(fn,fpfirst,fplast,lastnumchars) be
[ let rgca = vec maxbp+1;
let rgbp = vec maxbp+1;
let vpa = nil;
if fplast ls fpfirst then return;
vpa << VPA.fn = fn;
for fp = fpfirst to fplast do
	[ vpa << VPA.fp = fp;
	rgca ! (fp-fpfirst) = getvp(vpa);
	rgbp ! (fp-fpfirst) = vbp;
	] 
rgca ! (fplast-fpfirst+1) = dnbp ! bpbuff;
for fp = fpfirst to fplast do
	[ let bp = rgbp ! (fp-fpfirst);
	rglastused ! bp = 1;
	rgbs ! bp = 0;
	rgnchlast ! bp = (fp eq fplast) ? lastnumchars,#1000;
	] 
let of = mpfnof ! fn;
let rgda = lv (of >> OF.rgda);
let fileid = lv (of >> OF.fileid);
unless of >> OF.wf then errhlt("nwf");
fpfirst = fpfirst+1;
fplast = fplast+1;
if ((rgda ! fpfirst eq fillInDA) % (rgda ! fpfirst eq eofDA)) & (fpfirst eq 1) then
	[ if ActOnPages(0,rgda,fileid,0,0,DCread,0,0,dnbp ! bpbuff,0) then errhlt("aop");
	] 
test vextendof ifnot
	[ WritePages(rgca-fpfirst,rgda,fileid,fpfirst,fplast,0,0,lastnumchars,0);
	if ((rgda ! (fplast+1) eq eofDA) % (rgda ! (fplast+1) eq fillInDA)) & (lastnumchars eq #1000)  then
		[ WritePages(rgca-fpfirst,rgda,fileid,fplast,fplast+1,0,0,0,0);
		vextendof = true;
		] 
	] 
ifso	WritePages(rgca-fpfirst,rgda,fileid,fpfirst,((lastnumchars eq #1000) ? fplast+1,fplast),0,0,((lastnumchars eq #1000) ? 0,lastnumchars),0);
] 


// T R I M S
//
and trims(fn) be
[ let of = mpfnof ! fn;
if of >> OF.wf then
	[ let rgda = lv (of >> OF.rgda);
	let fp = (of >> OF.macpos) << PCD.p+1;
	let fileid = lv(of >> OF.fileid);
	if (rgda ! (fp+1) ne fillInDA) & (rgda ! (fp+1) ne eofDA) then
		DeletePages(dnbp ! bpbuff,rgda ! (fp+1),fileid,fp+1);
	of >> OF.macfp = fp+1;
	rgda ! (fp+1) = 0;
	] 
]