// ISF.BCPL -- implement indexed sequential files
// last modified March 28, 1977  11:22 AM
// Copyright Xerox Corporation 1979

	get "isf.d"

external	// entry procedures
[	IndexedPageIO	// (fmap, firstrn, core, npg, wflag[, lastnc]) -> lastnc
	WriteFmap	// (fmap)
]

external
[		// O.S.
	SetBlock; Zero
	CallSwat
	ActOnDiskPages
	WriteDiskPages
	Allocate; Free
	Usc
	Dvec
]


let IndexedPageIO(fmap, firstrn, core, npg, wflag, lastnc; numargs na) = valof
// wflag=-1 for write, 0 for read, 1 for read + extend
// returns numchars of last page transferred
[	let action = (wflag ls 0? DCwriteD, DCreadD)
	let pagesize = 1 lshift fmap>>FM.disk>>DSK.lnPageSize
	if na ls 6 then lastnc = pagesize*2
	if Usc(firstrn+npg, NextFmap(fmap)) ge 0 then morepageio(fmap, firstrn, core, npg, wflag)
	let CAs = vec ppc
	let DAs = vec ppc	// ppc+1 words!
	let ca, rn0, pagesleft = core, firstrn, npg
	let nch = nil
	while pagesleft gr 0 do
	 [ let np = min(pagesleft, ppc)
	   for j = 0 to np-1 do
	    [ CAs!j = ca; ca = ca+pagesize
	      DAs!j = LookupFmap(fmap, rn0+j)
	    ]
	   DAs!np = fillInDA
	   pagesleft = pagesleft-np
	   nch = (pagesleft eq 0? lastnc, pagesize*2)
	   ActOnDiskPages(fmap>>FM.disk, CAs-rn0, DAs-rn0, lv fmap>>FM.fp, rn0, rn0+np-1, action, lv nch)
	   rn0 = rn0+np
	 ]
	resultis nch
]

and morepageio(fmap, firstrn, scratch, npg, wflag) be
[	let pagesize, firstda = 1 lshift fmap>>FM.disk>>DSK.lnPageSize, LookupFmap(fmap, firstrn)
	let zone = fmap>>FM.zone
	if wflag eq -1 then
	 test zone eq -1
	  ifso [ scratch = pagesize; Dvec(morepageio, lv scratch) ]
	  ifnot scratch = Allocate(zone, pagesize)
	let lastrn, lastmaprn = firstrn+npg, NextFmap(fmap)
	let rn = lastmaprn-1
	let DAs = vec ppc+2	// ppc+3 words!
	DAs!0 = (rn eq 0? eofDA, LookupFmap(fmap, rn-1))
	let nch = nil
	while rn ls lastrn do
	 [ DAs!1 = LookupFmap(fmap, rn)
	   let np = min(ppc, lastrn-rn)
	   SetBlock(DAs+2, fillInDA, np+1)
	   let nrn = ActOnDiskPages(fmap>>FM.disk, 0, DAs+1-rn, lv fmap>>FM.fp, rn, rn+np-1, DCreadD, lv nch, DCreadD, scratch)
	   if nch eq 0 then	// extend file
	    test nrn eq rn
	    ifnot	// too hard to pick up
		np = nrn-rn
	    ifso
	    [ let nxp = fmap>>FM.extend
	      unless (nxp gr 0) & (wflag ne 0) do CallSwat("Attempt to access non-existent page")
	      if np ls nxp then np = nxp
	      Zero(scratch, pagesize)
	      SetBlock(DAs+2, fillInDA, np+1)
	      DAs!(np+2) = eofDA
	      WriteDiskPages(fmap>>FM.disk, 0, DAs+1-rn, lv fmap>>FM.fp, rn, rn+np, DCwriteD, 0, 0, scratch)
	    ]
	   for j = 1 to np do
	    [ let xrn, xda = rn+j, DAs!(j+1)
	      ExtendFmap(fmap, xrn, xda)
	      if xrn eq firstrn then firstda = xda
	    ]
	   DAs!0 = DAs!np
	   rn = rn+np
	 ]
	ExtendFmap(fmap, firstrn, firstda)	// just in case map is full
	if NextFmap(fmap) gr lastmaprn then WriteFmap(fmap)
	if (wflag eq -1) & (zone ne -1) then Free(zone, scratch)
]

and min(x, y) = (x ls y? x, y)

and WriteFmap(fmap) be
[	if fmap>>FM.rewrite then
	 [ ActOnDiskPages(fmap>>FM.disk, 0, lv fmap>>FM.DA0, lv fmap>>FM.fp, 1, 1, DCwriteD, 0, DCwriteD, fmap)
	 ]
]

and LookupFmap(fmap, rn, force; numargs n) = valof
[	if (rn eq fmap>>FM.onern) & ((n ls 3) % (not force)) then
	   resultis fmap>>FM.oneda
	let hi = fmap>>FM.last
	if Usc(rn, fmap!hi) ge 0 then resultis fillInDA
	let lo = mapoffset
	while hi-lo gr 2 do
	 [ let mid = ((lo+hi) rshift 1) & -2
	   test Usc(rn, fmap!mid) ge 0
	    ifso lo = mid
	    ifnot hi = mid
	 ]
	let lp = lv (fmap!lo)
	resultis (lp!1+rn-@lp)
]

and ExtendFmap(fmap, rn, da) = valof
[	fmap>>FM.onern, fmap>>FM.oneda = rn, da
	let last = fmap>>FM.last
	let lastp = lv (fmap!last)
	if rn ne @lastp then resultis false
	let curva = da
	test curva eq (lastp!-1)+@lastp-(lastp!-2)
	 ifso	// still in same chunk
	   @lastp = @lastp+1
	 ifnot	// start new chunk
	   test last eq fmap>>FM.end
	    ifso	// out of space
	      resultis false
	    ifnot
	    [ lastp!1, lastp!2 = curva, @lastp+1
	      fmap>>FM.last = last+2
	    ]
	resultis true
]

and NextFmap(fmap) = fmap!(fmap>>FM.last)