// FileIOSubrs.bcpl
// Last change August 2, 1981  12:43 AM by Beau Sheil
// Tone change March 17, 1981  4:49 PM by Beau Sheil
// Chord change November 20, 1980  2:52 PM by Beau Sheil
// Previous last change August 18, 1980  12:31 PM by Beau Sheil

	get "AltoFileSys.d"
	get "Disks.d"
	get "LispBcpl.decl"
	get "Stats.decl"
	get "Streams.d"

external [	// defined here
	AddDISKPAGES; CREATEFILE0; GETPAGEHINT; READDISKPAGE
	RELEASEPAGES; WRITEDISKPAGE; COPYSYS0
	OutputStream		// used by stats to access log file

		// statics used
	@lvNIL; @TopLevelFrame
	EmuDiskVp; EmuDiskBuffer; sysDisk; LispFmap; @MiscSTATSbase

		// O.S. procedures used
	Resets; Closes; WriteBlock; Zero; CallSwat; Min; MyFrame
	TruncateDiskStream; DeleteDiskPages; PositionPage; SetBlock
	CreateDiskFile; CreateDiskStream; ActOnDiskPages; WriteDiskPages 

		// procedures used
	@BGetBase; @BSetBR; @XSetBR; @RRead; @RWrite; @XGetBase; @XPutBase
	EqNIL; IGetBase; IPutBase; Timer; WriteStatsX; RAIDCode
	SmallUnbox; SmallNegUnbox; MkSmallPos; MkSmallNeg
	VP; MovePage; SysErr; IndexedPageIO; FlushVM; MakeVmemRO
	]

let AddDISKPAGES(lvFid, lvPn, lvNpages, lvAptr) = valof
   [
   let fp = vec lFP; GetFptrArg(lvFid, fp)

// lvPn is first page to write, but since lisp numbers pages with leader
// page = -1, lvPn=lastKnown page for the BFS and ge 0, since even empty
// files contain one data page
   let lastKnown = SmallUnbox(lvPn)
   XSetBR(lvAptr)
   let DAs = vec 102
   DAs!0 = RRead(lastKnown-1); DAs!1 = fillInDA

   [
   let nC = 0					// number of Chars

// read last page so we can write it back with new next page addr in label
   ActOnDiskPages(sysDisk, 0, DAs-lastKnown, fp, lastKnown, lastKnown,
         DCreadD, lv nC, 0, EmuDiskBuffer, 0, lv HintError, false, lastKnown)
// BFS does not zero page trailers as Lisp requires if included in file.
   let nW = nC rshift 1				// number of words used
   Zero(EmuDiskBuffer+nW, WordsPerPage-nW)
   ]

// CA and DA format: last but 1 page, last page, 100 new pages, dummy entry
   let ca = vec WordsPerPage-1; Zero(ca, WordsPerPage)
   let CAs = vec 102; SetBlock(CAs, ca, 103)
   CAs!1 = EmuDiskBuffer			// old last page data
   let nPages = SmallUnbox(lvNpages)
   while nPages gr 0 do
   [
   let dopages = (nPages gr 100 ? 100, nPages)
   let lastPage = lastKnown + dopages

   DAs!0 = lastKnown gr 1 ? RRead(lastKnown-2), fp>>FP.leaderVirtualDa
   DAs!1 = RRead(lastKnown-1); SetBlock(DAs+2, fillInDA, dopages+1)
   WriteDiskPages(sysDisk, CAs+1-lastKnown, DAs+1-lastKnown, fp, lastKnown, 
      lastPage, DCwriteD, 0, 0, 0, 0, lv HintError, 0, lastKnown)
   for i = 2 to dopages+1 do RWrite(lastKnown+i-2, DAs!i)
   CAs!1 = ca					// page of zeroes now
   lastKnown = lastKnown + dopages
   nPages = nPages - dopages
   ]
   resultis lvNIL
   ]

and CREATEFILE0(lvFptr, makeDir) = valof
   [
   let dir = 0
   unless EqNIL(makeDir) do dir<<SN.directory = 1
   let fp = vec lFP
   CreateDiskFile(sysDisk,"$.",fp,0,dir)
   SetFptrArg(lvFptr,fp)
   resultis lvFptr
   ]

and GETPAGEHINT(lvFid, lvPn, lvNpages, lvAptr) = valof
   [
   let fp = vec lFP; GetFptrArg(lvFid, fp)
   XSetBR(lvAptr)
   let apn = MakeBFSPageN(lvPn)
   let DAs = vec 101
   DAs!0 = apn ? RRead(apn-1), fp>>FP.leaderVirtualDa

   let nPages = SmallUnbox(lvNpages)
   let pagesLeft = nPages
   let donePages = 0

   while pagesLeft gr 0 do
   [
   SetBlock(DAs+1, fillInDA, 101)
   let nPagestoRead = (pagesLeft gr 100 ? 100, pagesLeft)
   pagesLeft = pagesLeft - nPagestoRead
   let lastPageRead =
       ActOnDiskPages(sysDisk, 0, DAs-apn, fp, apn, apn+nPagestoRead,
            DCreadD, 0, 0, EmuDiskBuffer, 0, lv HintError)

// write DAs into Aptr - adjust page numbers for LISP
   for i = apn+1 to lastPageRead do RWrite(i-1, DAs!(i-apn))
   donePages = donePages + lastPageRead - apn
   apn = lastPageRead
   DAs!0 = RRead(lastPageRead-1)
   ]
   resultis MkSmallPos(donePages)
   ]

and READDISKPAGE(lvFid, lvPn, lvBptr, lvDA) = valof
   [
   let fp = vec lFP; GetFptrArg(lvFid, fp)
   let apn = MakeBFSPageN(lvPn)
   let DAs = vec 1; DAs!1 = fillInDA
   DAs!0 =  apn ? SmallUnbox(lvDA), fp>>FP.leaderVirtualDa
   let lvNumChars = vec 1
   unless EqNIL(lvBptr) do
      [ if lvBptr>>VA.wordN ne 0 then RAIDCode("Not page aligned", lvBptr)
	XPutBase(lvBptr, 0)		// write ref the page buffer
      ]

   // Necessary to do XPutBase before ActOnDiskPages
   // because faulting might cause disk action

   ActOnDiskPages(sysDisk, 0, DAs-apn, fp, apn, apn,
         DCreadD, lvNumChars, 0, EmuDiskBuffer, 0, lv HintError)
   unless EqNIL(lvBptr) do MovePage(VP(lvBptr), EmuDiskVp)
   resultis MkSmallPos(lvNumChars!0)
   ]

// Releases pages of Fid, starting at page pn.
// Can be used to delete a whole file

and RELEASEPAGES(lvFid, lvPn, lvDA) = valof
   [
   let fp = vec 5; GetFptrArg(lvFid, fp)
   let apn = MakeBFSPageN(lvPn)
   let DA = apn ? SmallUnbox(lvDA), fp>>FP.leaderVirtualDa
   DeleteDiskPages(sysDisk, EmuDiskBuffer, DA, fp, apn)
   resultis lvNIL
   ]

and WRITEDISKPAGE(lvFid, lvPn, lvBptr, lvDA, lvNbytes) = valof
   [
   let fp = vec lFP; GetFptrArg(lvFid, fp)
   let apn = MakeBFSPageN(lvPn)
   let DAs = vec 2; DAs!0, DAs!2 = fillInDA, fillInDA
   DAs!1 = apn ? SmallUnbox(lvDA), fp>>FP.leaderVirtualDa

   if lvBptr>>VA.wordN ne 0 then RAIDCode("Not page aligned", lvBptr)
   XGetBase(lvBptr)		// read ref the page buffer!!

   let n = SmallUnbox(lvNbytes)
   MovePage(EmuDiskVp, VP(lvBptr))
   WriteDiskPages(sysDisk, 0, DAs-apn+1, fp, apn, apn, DCwriteD,
         0, n, EmuDiskBuffer, 0, lv HintError)
   resultis lvNbytes
  ]

and MakeBFSPageN(lvPn) = 
   (lvPn>>VA.vahi eq SMALLPOSspace) ?
      lvPn>>VA.valo + 1,	// lisp starts pns at -1 for leader page
      (SmallNegUnbox(lvPn) eq -1 ? 0, RAIDCode("Invalid page #", lvPn) )

and GetFptrArg(lvFptr, f) be
   [
   XSetBR(lvFptr)
   for i = 0 to lFP-1 do f!i = RRead(i)
   ]

and SetFptrArg(lvFptr, f) be
   [
   XSetBR(lvFptr)
   for i = 0 to lFP-1 do RWrite(i, f!i)
   ]

and HintError(s, cb, code) = valof	// BFS errors - diff args from SysErr
   [
   MyFrame()!0 = TopLevelFrame		// set return addr to return from SUBR
   resultis selecton code into		// error code switch
               [ case 1102: MkSmallNeg(-22)	// error 22 if disk full
                 case 1105: MkSmallNeg(-41)	// error 41 if protected
                 default:   SysErr(0, code) ]
  ] 

and OutputStream(lvFid) = valof
   [
   let fp = vec lFP; GetFptrArg(lvFid, fp)
   let st = CreateDiskStream(fp, ksTypeWriteOnly, wordItem, 0, StreamError)
   unless st do RAIDCode("Cant create stream", lvFid)
   resultis st
   ]

and COPYSYS0(lvFid) = valof
   [
   FlushVM()

   let st = OutputStream(lvFid)
   Zero(EmuDiskBuffer, WordsPerPage)
   WriteBlock(st, EmuDiskBuffer, WordsPerPage)	// page 1 <- isf index page

   let pvec = vec 4*WordsPerPage
   let Last = IGetBase(IFPNActivePages) + FirstVmemBlock - 1
   let i = FirstVmemBlock
   [ let np = Min(Last - i,  4)
     IndexedPageIO(LispFmap, i, pvec, np, 1)
     WriteBlock(st, pvec, np*WordsPerPage)
     i = i + np
   ] repeatuntil i ge Last

   TruncateDiskStream(st)			// in case using old file
   Resets(st); Closes(st)
   MakeVmemRO()
   resultis lvNIL
   ]

and StreamError(s, code) = HintError(s, 0, code)	// adjust args for HE