// SpruceFiles.Bcpl -- Spruce Files -- page-level, buffered operation
// Errors 2000

get "sprucefiles.d"
get "isf.d"
get "bfs.d"

// Spruce Files
//	A SPruceFile structure contains an Isf FM (file map), completely filled in, and descriptions of the
// state of a number of file buffers (page number, cleanliness, buffer location). Isf routines are used for
// access to files via this structure; this package provides routines for creating the structures and
// (optionally) the files, deleting the structures, for attaching SpruceStreams to them (n readers, or no
// readers and one reader/writer), and for finding and filling the core buffers.

external [ // defined here
	UnAccessSpruceFile; FindSprucePage; GetSprucePage; PutSprucePage
	AccessSpruceFile; DiskObject; FileLeng; InitSpruceFile; ResetSpruceFile
	]

external [ // external
// from OS
	CallersFrame; DefaultArgs; Zero; OpenFile; FileLength; GetCurrentFa; Closes; sysDisk
// from ISF
	LookupFmap
// From Spruce Utilities
	Max; Min; PageToPos
// From Other Spruce Sources
	SpruceError; FSGetX; FSGet; FSPut; SpruceZone; tridentDisk; drive1Disk
// From SpruceFsParams
	TfsParams; BfsParams
// From SpruceFilesMl
	VpageToRpage // virtual to real
// From packages
	Dequeue; Enqueue; InsertAfter; Unqueue
// From Mevents
	// ReportEvent
	]

static dcbHead; manifest DCBHead = #420

//	Called for one of three reasons:
// by Create... to set up major file structures, cb zone, etc.;  after restoration from checkpoint file, to
// reset all values;  whenever any of the buffering decisions must be changed.
//	Assumes that no substructures are currently allocated, independent of pointer values. So, if called
// more than once during one zone era, a call to Reset... must precede it. This is NOT enforced!!
// If maxAhead is 0, no cbzone will be allocated

let InitSpruceFile(sF, numBuffers, numCbs, zone; numargs na) be
	[
	// prepare restored file descriptor for file activity
	DefaultArgs(lv na, 1, sF>>SPruceFile.numBuffers, sF>>SPruceFile.numCbs, SpruceZone)
	if sF>>SPruceFile.valid then
	    test numBuffers eq sF>>SPruceFile.numBuffers & numCbs eq sF>>SPruceFile.numCbs &
		zone eq sF>>SPruceFile.zone ifso return ifnot ResetSpruceFile(sF)
	// guaranteed "invalid" at this point
	sF>>SPruceFile.zone = zone // file now valid
	sF>>SPruceFile.readers = 0
	sF>>SPruceFile.numCbs = numCbs
	let map = sF>>SPruceFile.map
	let disk = DiskObject(sF>>SPruceFile.deviceCode)
	map>>FM.zone, map>>FM.disk = zone, disk
	let lnPageSize = disk>>DSK.lnPageSize
	sF>>SPruceFile.lnPageSize = lnPageSize
	sF>>SPruceFile.pageSize = 1 lshift lnPageSize
	Zero(lv sF>>SPruceFile.bufQs^0, 6) // 3 queues
	let fParams = BfsParams()
	if sF>>SPruceFile.deviceCode eq DISKT80 then
	    [
	    fParams = TfsParams()
	    // half the buffers for Trident
	    numBuffers = (numBuffers+1) rshift 1
	    ]
	sF>>SPruceFile.fParams = fParams
	sF>>SPruceFile.numBuffers = numBuffers
	let cbz = sF>>SPruceFile.cbz; if not cbz & numCbs then
	    [
	    let lenCBZ = fParams>>FParams.lCBZ+numCbs*(fParams>>FParams.lCB+1)
	    cbz = FSGetX(lenCBZ)
	    fParams>>FParams.InitializeCbStorage(disk, cbz, 0, lenCBZ, 0, fParams>>FParams.lvDefaultErrorRtn)
	    cbz!(fParams>>FParams.offsetCleanup) = PostDone
	    ]
	sF>>SPruceFile.cbz = cbz
	]

and ResetSpruceFile(spruceFile) be // must be initted again before use! But file assumed valid
	[
	if spruceFile>>SPruceFile.readers then
		SpruceError(2040,spruceFile)
	let q = lv spruceFile>>SPruceFile.diskQ; while q>>Q.head do CleanUp(spruceFile, true)
	q = lv spruceFile>>SPruceFile.memQ
	let zone = spruceFile>>SPruceFile.zone
	while q>>Q.head do FSPut(Dequeue(q), zone)
	Zero(lv spruceFile>>SPruceFile.cbQ, 2)
	let cbz = spruceFile>>SPruceFile.cbz; if cbz then FSPut(cbz, zone)
	spruceFile>>SPruceFile.cbz = 0
	spruceFile>>SPruceFile.valid = 0
	]

//	Spruce File access functions, for attaching streams to the file.
// AccessSpruceFile(spruceFile, type [... spruceReadAccess]) grants read or read/write access to the file,
// if such access is valid. Standard stuff; many readers or one writer. Returns false if unsuccessful, -1
// if write access granted, number of readers if read access granted. UnAccessSpruceFile(spruceFile)
// cancels write access or reduces the reader count. It returns the reader count to indicate whether the
// file can be forgotten. This collection is relatively error prone, in that no checking for proper use is
// made after appropriate access is granted. ~~ Because Spruce Bands code reads and writes same file
// from multiple streams, treat all requests as read requests for the present. ~~

and AccessSpruceFile(spruceFile, type; numargs na) = valof
	[
	if na>1 then na = 1 // ~~ all requests are for read access! (see above)
	DefaultArgs(lv na, 1,     spruceReadAccess)
	let readers = spruceFile>>SPruceFile.readers
	if readers < 0 % (readers ne 0 & type eq spruceWriteAccess) resultis false
	readers = readers + type
	spruceFile>>SPruceFile.readers = readers
	resultis readers
	]

and UnAccessSpruceFile(spruceFile) = valof
	[
	let readers = spruceFile>>SPruceFile.readers-1
	if readers<0 then readers = 0
	spruceFile>>SPruceFile.readers = readers
	// accessibility check
	if readers resultis readers
	while spruceFile>>SPruceFile.diskQ.head do CleanUp(spruceFile, true) // disk activities cease
	let sP = spruceFile>>SPruceFile.memQ.head
	while sP do
		[
		if sP>>SPrucePage.accessors % sP>>SPrucePage.dirty then
			SpruceError(2050, spruceFile, sP>>SPrucePage.pageNumber)
		sP = sP>>SPrucePage.link
		]
	resultis 0 // = readers
	]

and DiskObject(i) = selecton i into
	[ case DISK31: sysDisk; case DISK31B: drive1Disk; case DISKT80: tridentDisk; default: 0 ]

and FileLeng(sF, pPos, itemSize; numargs na) = PageToPos(
	pPos, sF>>SPruceFile.numPages, sF>>SPruceFile.numChars, (na eq 3? itemSize, wordItem), sF)

and GetSprucePage(sF,pageNo, numPages, fill; numargs na) = valof
    [
    // ReportEvent($G, pageNo)
    if na<4 then fill = true; unless fill do numPages = 1 // read in page contents
    let index = vec 20; Zero(index, 20)
    let firstPage, lastPage, backwards, len, sP= pageNo, nil, false, 0, nil
    if numPages<0 then [ backwards = true; numPages = -numPages; firstPage = firstPage-numPages+1 ]
    if numPages>20% not sF>>SPruceFile.valid then SpruceError(2060, sF)
    lastPage = Min(sF>>SPruceFile.numPages, firstPage+numPages-1)
    firstPage = Max(1, firstPage); numPages = lastPage-firstPage+1
    let base = index-firstPage
    CleanUp(sF, false)	// post completions, rescue all complete cbs -- retry on errors
    for i = 0 to 1 do // gather existing pages in range
	[ sP = sF>>SPruceFile.bufQs^i.head // one of two 
	while sP do
	    [
	    let pn = sP>>SPrucePage.pageNumber
	    if firstPage le pn & pn le lastPage then base!pn = sP
	    len = len+1; sP = sP>>SPrucePage.link
	    ]
	]
    let oP = lv sF>>SPruceFile.memQ
    for i = firstPage to lastPage do
	[ sP = 0
	let pNo = backwards? firstPage+(lastPage-i), i
	if base!pNo loop
	if len<sF>>SPruceFile.numBuffers then
	    [
	    sP = FSGet(minLenSPrucePage+sF>>SPruceFile.pageSize, sF>>SPruceFile.zone)
	    test sP then [ len = len+1; Enqueue(oP, sP) ] or len = #77777
	    ]
	unless sP do
	    [
	    sP, oP = oP>>SPrucePage.link, sP
	    unless sP do test pageNo ne pNo break
		or [ CleanUp(sF, true); oP = lv sF>>SPruceFile.memQ; loop ]
	    let pn = sP>>SPrucePage.pageNumber
	    unless sP>>SPrucePage.accessors%sP>>SPrucePage.dirty%
	    	firstPage le pn&pn le lastPage break
	    ] repeat
	unless sP break; sP>>SPrucePage.status = 0
	sP>>SPrucePage.buffer = (lv sP>>SPrucePage.buffer)+1 // ~~ for now
	base!pNo = sP; sP>>SPrucePage.pageNumber = pNo
	]
    sP = base!pageNo; unless sP do SpruceError(2030, sF, pageNo)
    sP>>SPrucePage.accessors = sP>>SPrucePage.accessors+1
    // ~~ ugh! if still recovering from error, may look unqueued for transfer; need another bit
    while sF>>SPruceFile.reschedule do CleanUp(sF, false) // ~~ ugh
    if not fill & not sP>>SPrucePage.scheduled then
	[ sP>>SPrucePage.numChars = pageNo eq sF>>SPruceFile.numPages?
	    sF>>SPruceFile.numChars, sF>>SPruceFile.pageSize lshift 1
	// ReportEvent($g, pageNo)
	resultis sP ]  // don't fill, so don't care about contents
    let fileBackwards = sF>>SPruceFile.backwards
    if backwards ne fileBackwards&(sP>>SPrucePage.valid%sP>>SPrucePage.scheduled) then numPages=-1
    for i = 0 to numPages-1 do // read numPages
	[ let aSP = index!(fileBackwards? numPages-1-i, i)
	  if aSP then
	    unless aSP>>SPrucePage.valid%aSP>>SPrucePage.scheduled%Schedule(sF, aSP, opRead) break ]
    until sP>>SPrucePage.valid do CleanUp(sF, true)
    // ReportEvent($g, pageNo)
    resultis sP
    ]

and PutSprucePage(sF, sP) = valof
    [
    unless sP resultis 0
    let pageNo = sP>>SPrucePage.pageNumber
    if sP>>SPrucePage.dirty then
	[
          // ReportEvent($W, sP>>SPrucePage.pageNumber)
	sP>>SPrucePage.dirty = false
	CleanUp(sF, false) // account for disk activity
	unless Schedule(sF, sP, opWrite) do CleanUp(sF, true) repeatuntil sP>>SPrucePage.scheduled
          // ReportEvent($w, sP>>SPrucePage.pageNumber)
	]
    sP>>SPrucePage.accessors = Max(sP>>SPrucePage.accessors-1,0)
    resultis sP // don't know why
    ]

and Schedule(sF, sP, operation) = valof // returns true if sP has been presented to microcode queue
    [
    // ReportEvent($S, sP>>SPrucePage.pageNumber + operation lshift 8)
    if sF>>SPruceFile.deviceCode eq DISKT80&@DCBHead then
	[ dcbHead = @DCBHead; @DCBHead = 0 ] // turn off display, perhaps
    sP>>SPrucePage.valid = false; sP>>SPrucePage.scheduled = false
    test operation eq opReschedule then operation = sP>>SPrucePage.operation
      or [
	Unqueue(lv sF>>SPruceFile.memQ, sP) // it's there, but it's OK if it isn't
	sP>>SPrucePage.operation = operation
	Enqueue(lv sF>>SPruceFile.diskQ, sP)
	]
    let cb = Dequeue(lv sF>>SPruceFile.cbQ); unless cb do
	[ sF>>SPruceFile.reschedule = true; resultis false ]
    sP>>SPrucePage.cb = cb
    sP>>SPrucePage.scheduled = true
    // Do Command
    // can add simulation at this point if desirable
    let map = sF>>SPruceFile.map
    let page = VpageToRpage(sF, sP>>SPrucePage.pageNumber)
    let fp, da = lv map>>FM.fp, LookupFmap(map, page)
    let disk = map>>FM.disk
    let op = operation eq opWrite? DCwriteD, DCreadD
    cb>>CB.link = 0 // DoDiskCommand doesn't clear
    sF>>SPruceFile.fParams>>FParams.DoDiskCommand(disk, cb, sP>>SPrucePage.buffer, da, fp, page, op)
    resultis true
    ]

and CleanUp(sF, doSomething) be // ****** sF MUST remain 1st arg!!! ******
    [
    // ReportEvent($C, doSomething)
    let disk, cbz, cbQ = sF>>SPruceFile.map>>FM.disk, sF>>SPruceFile.cbz, lv sF>>SPruceFile.cbQ
    let diskQ, fParams = lv sF>>SPruceFile.diskQ, sF>>SPruceFile.fParams
    cbz!(fParams>>FParams.offsetRetry) = MRetry
    if false then // entered from GetCb via MRetry label
      MRetry:
	[ // cbz has been rebuilt -- must reschedule all pending ops
	Zero(cbQ, 2)
	sF>>SPruceFile.reschedule = true
	let sP = diskQ>>Q.head
	// ReportEvent($X, sP? sP>>SPrucePage.pageNumber, -1)
	while sP do [ sP>>SPrucePage.scheduled = false; sP = sP>>SPrucePage.link ]
	// Retry activity complete, may be re-invoked without ultimate error
	]
    // Get cbs out of zone, post results
	[  // **** MUST call GetCb directly ****
	let cb = fParams>>FParams.GetCb(disk, cbz, false, true)
	unless cb do
	    [
    	    if dcbHead& not @(fParams>>FParams.nextDiskCommand) then
    		[ @DCBHead = dcbHead; dcbHead = 0 ] // turn on display, perhaps
	    test doSomething ifnot break
		ifso test diskQ>>Q.head then loop or SpruceError(2030, sF)
	    ]
	doSomething = false // did something
	Enqueue(cbQ, cb)
	] repeat
    
    // reschedule any operations unscheduled due to error
    if sF>>SPruceFile.reschedule then
	[
	let aSP = diskQ>>Q.head
	while aSP do // Schedule will NOT detect errors and get too recursive!
		[
		unless aSP>>SPrucePage.scheduled % Schedule(sF, aSP, opReschedule) break
		aSP = aSP>>SPrucePage.link
		]
	unless aSP do sF>>SPruceFile.reschedule = false
	]
    // ReportEvent($c, doSomething)
    ]

and PostDone(disk, cb) be // how to derive file from cb?
    [
    // **** N.B. CleanUp(sF) calls GetCb which calls PostDone ****
    let sF = @((@CallersFrame())+4) // **** VERY implementation-dependent ****
    let diskQ = lv sF>>SPruceFile.diskQ
    let sP, fParams = diskQ>>Q.head, sF>>SPruceFile.fParams
    if sF>>SPruceFile.deviceCode ne DISKT80&
	((not sP)%sP>>SPrucePage.cb ne cb) then // check for restore produced in previous GetCb
	test cb>>CB.diskAddress.restore eq 1 then return or SpruceError(2110) // synch. error
    unless Dequeue(diskQ) do SpruceError(2110)
    // ReportEvent($P, sP>>SPrucePage.pageNumber)
    sP>>SPrucePage.numChars =
	(cb!(fParams>>FParams.offsetLabelAddress))!(fParams>>FParams.offsetLabelNumChars)
    sP>>SPrucePage.valid = true // ship it!o
    sP>>SPrucePage.scheduled = false
    Enqueue(lv sF>>SPruceFile.memQ, sP)
    ]

// June 3, 1977  10:22 AM, created
// June 4-9, 1977, initial development
// June 27, 1977  4:02 PM, off-by-one bug in subfile offset setting
// June 27, 1977  10:54 PM, SpruceFileLength -> FileLeng
// July 5, 1977  8:37 AM, revise error codes to match "Press" approach
// July 5-21, 1977, major revisions
// August 4, 1977  9:53 PM, ~~ consider all Access.... requests to be read access requests
// August 5, 1977  9:16 AM, add backwards-arranged (by page) files
// December 21, 1977  1:11 PM, mark all page buffers empty after all readers go away
// March 10, 1978  8:56 AM, move infrequently used functions to sprucefilesinit.bcpl
// March 11, 1978  2:13 PM, use old buffer if not space for new one
// September 14, 1978  10:52 AM, DiskObject(deviceCode) maps codes to objects
// October 5, 1978  10:39 PM, add fill arg to GetSprucePage
// October 9, 1978  8:38 AM, add concurrent I/O!!
// October 9, 1978  10:35 PM, add reports
// October 10, 1978  12:13 PM, make work better
// October 10, 1978  4:59 PM, add retry code
// October 11, 1978  8:35 AM, modify retry code -- CleanUp does rescheduling -- doggedly
// October 11, 1978  12:24 PM, FindSprucePage reorganized for faster search
// October 11, 1978  3:34 PM, make above work
// October 12, 1978  12:03 AM, combine GetSprucePage and FindSprucePage
// October 13, 1978  4:44 PM, VpageToRpage in Schedule, just at disk interface -- still
//				need to account for backwards-oriented files in optimization code
// October 16, 1978  12:05 PM, disable ReportEvent via comment
// October 16, 1978  2:36 PM, reenable most reports, change W reports
// October 24, 1978  1:43 PM, try to make backwards files work reasonably well (reading)
// October 30, 1978  6:57 AM, Tfs->TFS
// October 31, 1978  8:09 AM, adjust buffer sizes for T80
// October 31, 1978  11:29 PM, use SPruceFile.fParams to compensate for different locations of things
// November 3, 1978  9:09 AM, turn off display when running T80
// November 5, 1978  12:35 PM, comment out event reporting
// February 20, 1979  9:08 AM, accommodate bfs change from CB.nextCommand to CB.link (!)
//