// Dirs.sr

// Last modified October 25, 1979  8:36 PM by Taft

get "BFS.DEF";
get "bravo1.df";
get "q.DF";
get "st.DF";
get "AltoFileSys.d";
get "VM.DF";
get "dir.DF";
// Incoming Procedures

external [
	movec;
	move;
	flushvm;
	Enqueue;
	remakevmtb;
	ScanPages;
	errhlta
	Dequeue;
	umin;
	sbwsize;
	ugt;
	ult;
	RealDA
	min;
	divmod;
	stput;
	stcopy;
	AllocVm;
	];

// Incoming Statics

external [
	dnbp;
	macbp;
	rgvpa;
	fpSysDir;
	rgbs
	diskKd
	rglastused
	defaultVersionsKept
	];

// Outgoing Procedures

external [
	FindFptr;
	NormalizeSbFile;
	FMatchDe;
	DirLkup;
	InitNmd;
	VerNext;
	AppendVer;
	];


manifest	[ 
	pidLlNmd = 5
	pidCwRem = 8
	pidBuf = 9
	pidFnewDe = 10
	pidCwNeeded = 11
	pidCwRead = 12
	pidDe = 13
	pidWaDe = 14
	pidCwMac = 15
	waNil = -1
	] 

// F I N D F P T R
//
let FindFptr(cfaDirEnd,llNmd,mpPgnDa,pgnMax) be
[ let cwRem = 0; let buf = 0; let fnewDe = true; let cwNeeded = nil;
let cwRead = 0; let de = vec ldeMax; let waDe = nil; let cwMac = nil

let fptrDir = lv (cfaDirEnd >> CFA.fp)
// SortAndNorm(llNmd)
cfaDirEnd >> CFA.fa.da = RealDA(cfaDirEnd >> CFA.fp.leaderVirtualDa);
cfaDirEnd >> CFA.fa.pageNumber = 0;
let poolBuf = vec maxbp*lBuf
let qBufFree = vec lQ; AllocVm(qBufFree,poolBuf,4);
let tc = ScanPages(cfaDirEnd,qBufFree,TcCollectDe,mpPgnDa,pgnMax)
] 

// S O R T A N D N O R M
// the sort got tossed as not worth it
// and SortAndNorm(llNmd) = valof
// [ let nmd = @llNmd
// while nmd ne 0 do
// 	[ let sbFile = lv nmd >> NMD.asbFile
// 	NormalizeSbFile(sbFile,lv nmd >> NMD.ver)
// 	if nmd >> NMD.ver ne 0 then nmd >> NMD.vc eq vcExact
// 	let nmdNext = nmd >> NMD.next;
// 	let pLinkPrev = lv tll 
// 		[ let nmd1 = @pLinkPrev
// 		let comp = valof
// 			[ if nmd1 eq 0 then
// 				resultis 1
// 			let tsb = lv nmd1 >> NMD.asbFile
// 			for i = 0 to sbwsize(sbFile)-1 do
// 				[ let td = sbFile ! i-tsb ! i
// 				unless td eq 0 then
// 					resultis td
// 				] 
// 			resultis 0
// 			] 
// 		if comp eq 0 then errhlt("sb=")
// 		if comp gr 0 then
// 			[ nmd >> NMD.next = nmd1
// 			@pLinkPrev = nmd
// 			break
// 			] 
// 		pLinkPrev = @pLinkPrev
// 		] repeat
// 	nmd = nmd >> NMD.next
// 	] 
// ] 

// T C C O L L E C T D E
//
and TcCollectDe(zone,Freturn) = valof
[ let scanParams = zone >> CBZ.extra
let fm = scanParams >> SCP.fmCaller
let de = fm ! pidDe
	[ if Freturn(zone) then
		resultis tcNotDone;
	if fm ! pidCwRem le 0 then
		[ if fm ! pidCwRem ls 0 then errhlta(198)
		unless fm ! pidBuf eq 0 then
			[ Enqueue(scanParams >> SCP.qBufFree,fm ! pidBuf)
			if ((fm ! pidBuf) >> BUF.numChars ne #1000) then
				resultis tcDone
			] 
		fm ! pidBuf = Dequeue(scanParams >> SCP.qBufRead)
		test fm ! pidBuf eq 0 ifnot
			[ fm ! pidCwRem = ((fm ! pidBuf) >> BUF.numChars) rshift 1
			fm ! pidCwMac = fm ! pidCwRem
			] 
		ifso	resultis tcToYou
		] 
	let bcw = fm ! pidCwMac-fm ! pidCwRem
	let ca = (fm ! pidBuf) >> BUF.ca+bcw
	if fm ! pidFnewDe then
		[ fm ! pidCwNeeded = ca >> DE.l
		fm ! pidFnewDe = false
		fm ! pidCwRead = 0
		@de = @ca
		if fm ! pidCwNeeded eq 0 then resultis tcDone
		fm ! pidWaDe = (((fm ! pidBuf) >> BUF.pgn-1) lshift 8)+bcw
		] 
	let tcw = umin(fm ! pidCwNeeded,fm ! pidCwRem)
	unless de >> DE.ty eq tyDeFree then
		move(ca,de+fm ! pidCwRead,tcw)
	fm ! pidCwNeeded = fm ! pidCwNeeded-tcw
	fm ! pidCwRem = fm ! pidCwRem-tcw
	fm ! pidCwRead = fm ! pidCwRead+tcw
	if fm ! pidCwNeeded eq 0 then
		[ FMatchDe(de,fm ! pidWaDe,fm ! pidLlNmd)
		fm ! pidFnewDe = true
		] 
	] repeat
] 

// F M A T C H D E
//
and FMatchDe(de,waDe,llNmd) = valof
[ let ver = nil; let nmd = @llNmd
while nmd ne 0 do
	[ test de >> DE.ty eq tyDeFree ifso
		[ if (de >> DE.l gr nmd >> NMD.ldeFree) & (nmd >> NMD.waDeFree eq waNil) then
			[ nmd >> NMD.waDeFree = waDe
			resultis false
			] 
		] 
	ifnot	[ if de >> DE.l gr ldeMax then errhlta(199)
		let tsb = lv nmd >> NMD.asbFile
		let feq = valof
			[
// this check is just for efficiency
			unless (de>>DE.asbFile.ch^0 & 137B) eq (tsb>>SB.ch^0 & 137B) resultis false
			let sbFile = lv de >> DE.asbFile;
			NormalizeSbFile(sbFile,lv ver)
			if ver eq 0 then ver = 1
			let cwSb = sbwsize (sbFile)
			for i = 0 to cwSb-1 do
				[
				unless (sbFile!i & 157737B) eq (tsb!i & 157737B) then
					resultis false
				] 
			resultis true
			] 

		if feq then
			[ let vcWanted = nmd >> NMD.vc
			let fmove = false
			if (vcWanted eq vcExact) then
				test (ver eq nmd >> NMD.ver) ifso
					fmove = true
				ifnot	resultis false
			nmd >> NMD.cver = nmd >> NMD.cver+1
			unless ugt(ver,nmd >> NMD.verMin) then
				[ nmd >> NMD.verMin = ver
				if vcWanted eq vcOldest then
					fmove = true
				] 
			unless ult(ver,nmd >> NMD.verMac) then
				[ nmd >> NMD.verMac = ver
				if vcWanted eq vcNewest then
					fmove = true
				] 
			if fmove then
				[ nmd >> NMD.ver = ver
				nmd >> NMD.waDe = waDe
				move(lv de >> DE.afptr,lv nmd >> NMD.afptr,lFP)
// 				resultis false
				] 
// 			resultis false
			] 
		] 
	nmd = nmd >> NMD.next
	] 
resultis false
] 

// N O R M A L I Z E S B F I L E
//
and NormalizeSbFile(sbFile,lvver,sbDest; numargs na) be
[ if na ls 3 then sbDest = sbFile
let fversOn = defaultVersionsKept ne 0
let ver = 0; let finVer = false; let ichLast = nil
let lsb = sbFile >> SB.cch
let ch = nil
for ich = 0 to lsb-1 do
	[ ch = sbFile >> SB.ch ^ ich
//	sbDest >> SB.ch ^ ich = ch % #40
	test ch eq $. ifso
		loop
	ifnot	test (ch eq $!) & fversOn ifso
		[ ver = 0
		ichLast = ich
		finVer = true
		] 
	ifnot	test finVer & (ch le $9) & (ch ge $0) ifso
		ver = ver*10+(ch-$0)
	ifnot	[ finVer = false; ver = 0]
	] 
unless finVer & (ver ne 0) then ichLast = lsb-((ch eq $.) ? 1,0)
sbDest >> SB.ch ^ ichLast = $.
sbDest >> SB.cch = ichLast+1
if ichLast << odd then
	sbDest >> SB.ch ^ (ichLast+1) = 0
// if ver eq 0 then ver = 1
if na gr 1 then @lvver = ver
] 

// D I R L K U P
//
// and DirLkup(sb,nmd,mpPgnDa,pgnMax; numargs na) = valof
// [ FindFptr(fpSysDir,lv nmd,mpPgnDa,pgnMax)
// resultis (nmd >> NMD.cver gr 0)
// ] 

// I N I T N M D
// 
and InitNmd(nmd,lnmd,sb,vc) be
[ if vc eq vcNew then vc = vcOldest
if vc eq vcNewestOrNew then vc = vcNewest
movec(nmd,nmd+lnmd-1,0)	// inits cver, ver, vermin, etc
nmd >> NMD.verMin = -1
nmd >> NMD.vc = vc
nmd >> NMD.waDeFree = waNil
let sbFile = lv nmd >> NMD.asbFile
stcopy(sbFile,sb)
nmd >> NMD.next = 0
NormalizeSbFile(sbFile,lv nmd >> NMD.ver)
let lsb = sbwsize(sbFile)
nmd >> NMD.ldeFree = ovhDe+lsb+3
if nmd >> NMD.ver ne 0 then nmd >> NMD.vc = vcExact
] 

// V E R N E X T
//
and VerNext(nmd) = valof
[ if defaultVersionsKept eq 0 then resultis 1
if nmd >> NMD.cver eq 0 then resultis 1
resultis nmd >> NMD.verMac+1
] 

// A P P E N D V E R
//
and AppendVer(sbFile,ver) be
[ if (defaultVersionsKept eq 0) then return
if ver eq 0 then ver = 1
let ich = sbFile >> SB.cch
if (sbFile >> SB.ch^(ich-1)) eq $. then
	ich = ich-1
stput(sbFile,ich, $!)
ich = ich+1
divmod(ver,1000,lv ver)
let divor = 100; let fstarted = false
while divor ne 0 do
	[ let digit = divmod(ver,divor,lv ver)
	divor = divor/10
	if fstarted % (digit ne 0) then
		[ stput(sbFile,ich,digit+$0)
		ich = ich+1
		fstarted = true
		] 
	] 
stput(sbFile,ich, $.)
sbFile >> SB.cch = ich+1
]