// OM  MODULE 
// Last modified November 30, 1979  2:21 PM by Taft

get "CHAR.DF"
get "HEAP.DF"
get "BRAVO1.DF"
get "altofilesys.d"
get "OM.DF"
get "display.DF"
get "vm.DF"
get "ST.DF"

// Incoming Procedures

external [
	TIMER
	waitforfd
	SeekTo;
	ReadVec;
	ult;
	ugt;
	ratio;
	errhlt;
	stget;
	move;
	gets;
	errck;
	hpfree;
	hpcompact;
	hpguarantee;
	getvp;
	FChInSb;
	GotoLabel;
	setupdate;
	findhpspace;
	umax;
	WriteDiskKd;
	ReadDiskKd;
	];

// Incoming Statics

external [
	vfloppy
	freet;
	freee;
	macww;
	ozone;
	ozonel;
	mpmnom;
	macmn;
	vpzone;
	vframe;
	vlabel;
	mpWwWwd;
	frameCom;
	labelFaultStor;
	vcfreemin;
	vfIniting
	chcom
	vup;
	vlptblMac;
	];

// Outgoing Procedures

external [
	activateomseq;
	updateptrs;
	swapout;
	deactivateomseq;
	ckom;
	hplay;
	SwappedOut;
	augmentomseq;
	inifixedstor;
	findomspace;
//	ResetOv;
	FFaultStor;
	];

// Outgoing Statics

external [
	voverlay;
	];

// Local Statics

static	[
	voverlay;
	];

//A C T I V A T E O M S E Q
//
let activateomseq(sbomseq,percentdov,cfixedstorage, fAug; numargs n) be
	[
	if n ls 3 then cfixedstorage = 0;
	if n ls 4 then fAug = false;
// 	let ffixedneeded = true;
	unless cfixedstorage eq 0 then
		cfixedstorage = cfixedstorage+lnovhdr+5;
	let rgomfetch = vec maxmn;
	let tcomfetch = 0;
	let cwOmNew = 0;
// 	let tsizactive = cfixedstorage;
	let tmn = nil;
	let tom = nil;
	let tov = nil;
	let omSeek = -1
	let crefFixedStor = FChInSb($B,sbomseq) ? 1,0
	for i = 0 to sbomseq >> SB.cch-1 do
		[ tmn = stget(sbomseq,i)-$A;
		tom = mpmnom ! tmn;
// 		if (fAug eq false) & (tom >> OM.cref ne 0) do
// 			errhlt("cref");
		let fFixedTooSmall = false
// 		test tmn eq mnfixedstor ifnot
// 			tsizactive = tsizactive+tom >> OM.cword 
// 		ifso	if ugt(cfixedstorage,tom >> OM.cword) then
		if (tmn eq mnfixedstor) & ugt(cfixedstorage,tom >> OM.cword) then
				fFixedTooSmall = true
		if tom >> OM.ov eq 0 % fFixedTooSmall then
			[ rgomfetch ! tcomfetch = tom;
			tcomfetch = tcomfetch+1;
			let tcw = nil;
			test tmn eq mnfixedstor ifso
				tcw = cfixedstorage
			ifnot
				[ tcw = tom >> OM.cword
				if omSeek eq -1 then omSeek = tom
				]
			cwOmNew = cwOmNew+tcw;
			]
		tom >> OM.cref = tom >> OM.cref+1;
		]
	if omSeek ne -1 then 
		SeekTo(omSeek >> OM.aFa.da);
	let base = ozone;
// 	let sizdovsp = 0;
// 	let totslop = 0;
// 	for i = 0 to macww-1 do
// 		[ let wwd = mpWwWwd ! i
// 		totslop = totslop+wwd>>WWD.hpUsed;
// 		] 
// 	totslop = totslop+ozonel-tsizactive;
// 	let sizdovspallowed = ratio(totslop,percentdov,100);
	tov = ozone;
	let ozonee = ozone + ozonel;
	let tlnmod = nil;
	test fAug ifso
		base = ozonee
	ifnot	until tov eq ozonee do
		[ if ugt (tov,ozonee) then errhlt("ozl");
		tlnmod = tov >> OV.lnmod;
 		tom = mpmnom ! (tov >> OV.mn);
// 		test (tom >> OM.cref ne 0) % ult(sizdovsp+tom >> OM.cword,sizdovspallowed)
		test (tom >> OM.cref ne 0) ifso
			[ if tom >> OM.ffixedstor then
				initfixedstor(cfixedstorage,base,true);
			if tom >> OM.ov ne base then
				[ move(tom >> OM.ov,base,tom >> OM.cword);
				if tom >> OM.ffixedstor then
					if tom >> OM.cref ne crefFixedStor then
						errhlt("fix")
				updateptrs(tom,base);
				]
			base = base+tom >> OM.cword;
// 			unless tom >> OM.cref ne 0 do sizdovsp = sizdovsp+tom >> OM.cword;
			]			
		ifnot swapout(tom);
// 		ifnot	if (tom >> OM.cword eq cfixedstorage) % ugt(tom >> OM.cword,cfixedstorage) then
// 				[ if tom >> OM.ov ne base then
// 					move(tom >> OM.ov,base,cfixedstorage);
// 				initfixedstor(cfixedstorage,base);
// 				base = base+cfixedstorage;
// 				ffixedneeded = false;
// 				]
		tov = tov + tlnmod;
		] 
// 	shrinkamount = (tsizactive+sizdovsp-ozonel+1) & (-2);
	let cwOvLeft = ozonee-base;
	let shrinkamount = (cwOmNew-cwOvLeft+1) & (-2)
	tradespacehpozone(shrinkamount,sbomseq,base)
	for i = 0 to tcomfetch-1 do
		[ tom = rgomfetch ! i;
		test tom >> OM.ffixedstor ifso
			initfixedstor(cfixedstorage,base,false);
		ifnot	[ let cfa = vec lCFA
			move(tom >> OM.fptr,cfa,lFP)
			move(lv (tom >> OM.aFa),lv (cfa >> CFA.fa),lFA)
//floppy stats
// 			let starttime= vec 2
// 			let firstPage= cfa>>CFA.fa.pageNumber
// 			let lastPage= firstPage + (tom>>OM.cword+255)/256
// 			if vfloppy then TIMER(starttime)
			ReadVec(cfa,tom >> OM.cword,base);
// 			if vfloppy then waitforfd(0,firstPage,lastPage,starttime,1)

			unless i eq tcomfetch-1 do
				SeekTo((rgomfetch ! (i+1)) >> OM.aFa.da);
			tov = base;
			tov >> OV.mn = tom >> OM.mn;
			] 
		updateptrs(tom,base);
		if tom>> OM.mn eq mnKd then
			ReadDiskKd();
		base = base+tom >> OM.cword;
		]
// 	if ffixedneeded then
// 		[ initfixedstor(cfixedstorage,base);
// 		base = base+cfixedstorage;
// 		]
	ozonel = base-ozone;
	let tpHeapMin = vpzone >> ZONE.min;
	unless vup then tpHeapMin = tpHeapMin-hpbuf;
	if ugt(base, tpHeapMin) then errhlt("hpo");
	]

// D E A C T I V A T E O M S E Q
//
and deactivateomseq(sbomseq,sbomseqtossable; numargs n) be
	[
	unless voverlay then return;
	if n ls 2 then sbomseqtossable = ""
	let tmn = 0;
	let tom = nil;
	for i = 0 to sbomseq >> SB.cch-1 do
		[ tmn = stget(sbomseq,i)-$A;
		tom = mpmnom ! tmn;
		unless tom >> OM.cref eq 0 then
			tom >> OM.cref = tom >> OM.cref-1;	
		]
// 	tom = mpmnom ! mnfixedstor;
// 	unless tom >> OM.cref eq 0 then
// 		tom >> OM.cref = tom >> OM.cref-1;
	let tomfirsttossed = 0;
	let tov = ozone;
	let ozonee = ozone + ozonel;
	let tcword = 0;
	until tov eq ozonee do
		[ if ugt(tov,ozonee) then errhlt("dozl");
		tmn = tov >> OV.mn;
		tom = mpmnom ! tmn;
		test (tom >> OM.cref eq 0) & ((sbomseqtossable eq 0) % FChInSb(tmn+$A,sbomseqtossable))
		ifso	if tomfirsttossed eq 0 then tomfirsttossed = tom
		ifnot tomfirsttossed = 0;
		tov = tov + tom >> OM.cword;
		] 
	unless tomfirsttossed eq 0 do
		[ let tcaddr = tomfirsttossed >> OM.ov;
		tov = tcaddr;
		until tov eq ozonee do
			[ let tmn = tov >> OV.mn;
			if tmn eq mnKd then
				WriteDiskKd();
			tom = mpmnom ! tmn;
			tcword = tom >> OM.cword;
			test tom >> OM.ffixedstor eq 0 
			ifso	swapout(tom);
			ifnot	[ tom >> OM.cword = 0;
				tom >> OM.ov = 0;	
				]
			tov = tov + tcword;
			] 
		hplay(-((ozonee-tcaddr-1) & (-2)),true);
		ozonel = tcaddr-ozone;
		]
	for ww = 0 to macww-1 do
		setupdate(ww);
	]

// A U G M E N T O M S E Q
//
and augmentomseq(sbomseq) be
	[
	activateomseq(sbomseq,0,0,true);
// 	unless voverlay then return;
// 	let tsizaug = 0;
// 	let tom = nil;
// 	let tmn = 0;
// // 	tom = mpmnom ! mnfixedstor;
// // 	tom >> OM.cref = tom >> OM.cref+1;
// 	for i = 0 to sbomseq >> SB.cch-1 do
// 		[ tmn = stget(sbomseq,i)-$A;
// 		tom = mpmnom ! tmn;
// 		tom >> OM.cref = tom >> OM.cref+1;
// 		if tom >> OM.ov eq 0 then
// 			tsizaug = tsizaug + tom >> OM.cword;
// 		]
// 	if tsizaug eq 0 then return;
// 	tradespacehpozone((tsizaug+1) & (-2),sbomseq,ozone+ozonel);
// 	let base = ozone+ozonel;
// 	let tov = nil;
// 	for i = 0 to sbomseq >> SB.cch-1 do
// 		[ tmn = stget(sbomseq,i)-$A;
// 		tom = mpmnom ! tmn;
// 		if tom >> OM.ov eq 0 then
// 			[ let cfa = vec lCFA
// 			move(tom >> OM.fptr,cfa,lFP)
// 			move(lv (tom >> OM.aFa),lv (cfa >> CFA.fa),lFA)
// //floppy stats
// 			let starttime= vec 2
// 			let firstPage= cfa>>CFA.fa.pageNumber
// 			let lastPage= firstPage + (tom>>OM.cword+255)/256
// 			if vfloppy then TIMER(starttime)
// 			ReadVec(cfa,tom >> OM.cword,base);
// 			if vfloppy then waitforfd(0,firstPage,lastPage,starttime,1)
// 
// 			tov = base;
// 			tov >> OV.mn = tom >> OM.mn;
// 			updateptrs(tom,base)
// 			base = base+tom >> OM.cword;
// 			]
// 		]
// 	unless base eq (ozone+ozonel+tsizaug) then errhlt("tsiz");
// 	ozonel = ozonel+tsizaug;
	]
	
// C K O M
//
// and ckom() be
// 	[
// 	let tbase = ozone;
// 	let tov = ozone;
// 	let tom = nil;
// 	let ozonee = ozone + ozonel;
// 	until tov eq ozonee do
// 		[ if ugt (tov,ozonee) then errck("oze",ozonee);
//  		tom = mpmnom ! (tov >> OV.mn);
// 		unless tom >> OM.ov eq tbase do errck("bse",tom);
// 		if tom >> OM.ffixedstor eq 0 then
// 			unless tom >> OM.cword eq tov >> OV.lnmod do errck("lnm",tom);
// 		unless ult(tbase-ozone,ozonel) do errck("ozl",tbase);
// 		tbase = tbase+tom >> OM.cword;
// 		tov = tov + tom >> OM.cword;
// 		] 
// 
// 	let tvpa = nil;
// 	for tmn = 2 to macmn do
// 		[ tom = mpmnom ! tmn;
// 		unless tmn eq tom >> OM.mn do errck("tmn",tom);
// 		tvpa << VPA.fn = fnom;
// 		tvpa << VPA.fp = tom >> OM.fp;
// 		tov = getvp(tvpa);
// 		unless tov >> OV.fp eq tom >> OM.fp do errck("vpa",tom)
// 		]
// 	]

// U P D A T E P T R S
//
and updateptrs(om,base) be
	[
	let tov = base;
	let reltbl = tov+tov >>OV.reltbl;
	let cstat = reltbl >> RELTBL.cstat;
	let rpr = lv(reltbl >> RELTBL.rvmpistatrpr);
	om >> OM.ov = base;
	base = base+lnovhdr;
 	for i = 0 to cstat-1 do
		[ @(rpr >> RPR.lvstat) = base+rpr >> RPR.rpc;
ckupdate:	rpr = rpr+lnrpr;
		]
	]

// S W A P O U T
//
and swapout(om) be
	[
	let tov = om >> OM.ov;
	let reltbl = tov+tov >>OV.reltbl;
	let cstat = reltbl >> RELTBL.cstat;
	let rpr = lv(reltbl >> RELTBL.rvmpistatrpr);
	for i = 0 to cstat-1 do
		[ @(rpr >> RPR.lvstat) = SwappedOut;
ckswap:		rpr = rpr+lnrpr;
		]
	om >> OM.ov = 0;
	]

// H P L A Y
//
and hplay(shrinkamount, up) = valof
	[
	let zmin = vpzone >> ZONE.min
	let zmax = vpzone >> ZONE.max
	let tfp = 0;
	if shrinkamount << odd then errhlt("odd");
	test shrinkamount gr 0 ifso
		[ 
// cheat display
		if shrinkamount gr vpzone>>ZONE.cfree then	
			unless hpguarantee(shrinkamount) then
				resultis false;
		hpcompact(up,
		    vpzone >> ZONE.min + (up? shrinkamount, 0),
		    vpzone >> ZONE.max + (up? 0, -shrinkamount)) ;
		] 
	ifnot	[ if shrinkamount gr -4 then resultis true;
		let newblock = nil;
		test up ifso
			[ vpzone >> ZONE.min = zmin+shrinkamount;
			newblock = zmin+shrinkamount;
			] 
		ifnot	[ vpzone >> ZONE.max = zmax-shrinkamount;
			newblock = zmax;
			let prevblock = zmax-(rv (zmax-bsiz));
			unless (prevblock >> HP.fp eq 0) % (prevblock >> HP.fp eq prevfree) then
				tfp = prevfree;
			] 
 		newblock >> HP.siz = -shrinkamount;
		newblock >> HP.fp = tfp;
		rv(newblock-shrinkamount-bsiz) = -shrinkamount;
		hpfree(lv (newblock >> HP.use));
		] 
	resultis true;
	]

// S W A P P E D O U T
//
and SwappedOut() be
	[
	errhlt("swp");
	]


// I N I T F I X E D S T O R
//
and initfixedstor(siz,ov,fClrOnOflow) be 
	[
	if siz eq 0 then return
	let om = mpmnom ! mnfixedstor;
// 	om >> OM.cref = om >> OM.cref+1;
	if fClrOnOflow & ugt(siz,om >> OM.cword) then
		[ siz = 0;
		ov = 0;
		] 
	om >> OM.ffixedstor = true;
	om >> OM.cword = siz;
	om >> OM.ov = ov;
	unless ov eq 0 then
		[ ov >> OV.mn = mnfixedstor;
		ov >> OV.lnmod = siz;
		ov >> OV.reltbl = siz-1;
		@(ov+ov >> OV.reltbl) = 0;
		freee = ov+siz-2;
		freet = ov+lnovhdr;
		] 
	]

// F I N D O M S P A C E
//
and findomspace(sbomseq) = valof
	[
	let comspace = 0;
	let mn = nil;
	for i = 0 to sbomseq >> SB.cch-1 do
		[ mn = stget(sbomseq,i)-$A;
		comspace = comspace+((mpmnom ! mn) >> OM.cword);
		]
	resultis comspace;
	]


// T R A D E S P A C E
//

and tradespacehpozone(hpshrinkamount,sbomseq,newozonee) be
[ 

// if (new size of ozone)+(c1%*(committed-c0)+c2) > findhpspace() then abort

if FFaultStor(hpshrinkamount) then
	[ ResetOv(newozonee)
	GotoLabel(frameCom,labelFaultStor,"hpg");
	]

// unless hplay(hpshrinkamount,true) do 
// 	[ for i = 0 to sbomseq >> SB.cch-1 do
// 		[ let tmn = stget(sbomseq,i)-$A;
// 		let tom = mpmnom ! tmn;
// 		tom >> OM.cref = tom >> OM.cref-1;
// 		]
// 	hplay((newozonee-(ozone+ozonel)+1) & (-2),true);
// 	ozonel = newozonee-ozone;
// 	GotoLabel(vframe,vlabel,"hpg");
// 	]
] 

// R E S E T O V
//
and ResetOv(ozonee; numargs carg) be
[
if carg ne 1 then errhlt("rov")
errhlt("ov");
// let ov = ozone
// // let ozonee = ozone + ozonel;
// until ov eq ozonee do
// 	[ if ugt (ov,ozonee) then errhlt("ozl");
// 	let lov = ov >> OV.lnmod
//  	let om = mpmnom ! (ov >> OV.mn);
// 	swapout(om);
// 	ov = ov+lov
// 	] 
// for mn = 1 to macmn-1 do
// 	[ let om = mpmnom ! mn
// 	om >> OM.cref = 0; 
// 	] 
// hplay(-(ozonel & (-2)),true)
// ozonel = 0
] 

// F F A U L T S T O R
//
and FFaultStor(hpshrinkamount) = valof
[ manifest [ c0 = #3000; c1 = 33; c2 = #1400 ]
let cwTot = ozonel+vpzone >> ZONE.max-vpzone >> ZONE.min
let cwAvail = findhpspace()
let cwCommitted = umax(cwTot-cwAvail, vlptblMac lshift 1)
let cwNeeded = umax(vcfreemin,(ozonel+hpshrinkamount))
let cwTweek = (chcom eq $p) % (chcom eq $q) ? 0, ratio(c1,umax(cwCommitted,c0),100)+c2
if (vfIniting eq false) & ugt(cwNeeded+cwTweek,cwAvail) then
	resultis true
resultis (hplay(hpshrinkamount,true) eq false)
]