// 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);
// ]
// ifnotunless 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;
]
ifnoterrhlta(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;
]
ifnoterrhlta(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
// ifnotresultis 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;
// ]
// ifnoterrhlta(147);
// (mpfnof ! fn)>>OF.pos = pos+2;
// ]
// ifnot[
//vlbput = trc<<odd ? false, true;
// test vlbput ifso
// vpwput>>lh = item
// ifnotvpwput>>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;
// ]
// ifnoterrhlta(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
ifnotresultis 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