// 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)