// BFS Base
// New Alto basic file system

// Last modified April 5, 1980  6:42 PM by Taft

get "altofilesys.d"

// Outgoing procedures
external [
	InitializeCbStorage; DoDiskCommand; GetCb
	ActOnPages;
	RealDA;
	]

// Outgoing statics
external [
	exchangeDisks
	maxEC
	restoreEC
	fillInDA
	eofDA
// these are defined later
	DCdoNothing; DCread; DCwrite; DCwriteLabel; DCseekOnly
	vwaitproc;
	vSkfd
	diskBTsize
	nTracks
	nSectors
	nDisks
	nHeads
	]
static [
	exchangeDisks=false
	maxEC=5
	restoreEC=3
	fillInDA=#77777
	eofDA=0
	vwaitproc;
	vSkfd
	diskBTsize
	nTracks
	nSectors
	nDisks
	nHeads
	]

// incoming procedures
external [
	Zero; MoveBlock
	SysErr
	ReturnTo
	DefaultArgs1
	DisableInterrupts; EnableInterrupts
	enqueue;
	divmod;
	Bug;
	]


// incoming statics
external [
	oneBits
	freePageId
	ccycles;
	centries;
// 	dnbp
	vmask; lvterminate
	]

get "BFS.DEF"
// the actions which are needed by callers of bfs are (external)
// statics; the others are manifests
static [
	DCdoNothing=#376	// only interpreted by ActOnPages
	DCread=diskCheck*(DCheaderx+DClabelx)+diskRead*DCdatax+DCaS
	DCwrite=diskCheck*(DCheaderx+DClabelx)+diskWrite*DCdatax+DCaS
	DCwriteLabel=diskCheck*DCheaderx+diskWrite*(DClabelx+DCdatax)+DCaS
	DCseekOnly=msb rshift offset DC.seekOnly+DCaS
	]
manifest [
	DCreadLabel=diskCheck*DCheaderx+diskRead*(DClabelx+DCdatax)+DCaS
	]



let InitializeCbStorage(zone, length, firstPage, retry,
  clearZone) be [
	if clearZone then Zero(zone, length)
	zone>>CBZ.length=length
	zone>>CBZ.currentPage=firstPage
	let e=lv zone>>CBZ.queueVec
	rv e=0; zone>>CBZ.queueTail=e
	e=e+1; zone>>CBZ.queueHead=e
	let cb=zone+length
		[
		cb=cb-lCB; if cb le e break
		cb>>CB.zone=zone; cb>>CB.retry=retry
		cb>>CB.status=DSfreeStatus
		rv e=cb; e=e+1
		] repeat
	zone>>CBZ.endQueueVec=e
	]

and NextCb(zone, pointer)=valof [
	let t=zone!pointer; let u=t+1
	if u ge zone>>CBZ.endQueueVec then u=lv zone>>CBZ.queueVec
	zone!pointer=u; resultis t
	]



// Expects command and label to both be zeroed on entry, or
// otherwise appropriately initialized
and DoDiskCommand(cb, CA, DA, fileId, pageNumber, action) be [
	let z=cb>>CB.zone

	cb>>CB.headerAddress=lv(cb>>CB.header)
	let la=cb>>CB.labelAddress
	if la eq 0 then [
		la=lv(cb>>CB.label)
		cb>>CB.labelAddress=la
		]
	cb>>CB.dataAddress=CA

	if cb>>CB.normalWakeups eq 0
	  then cb>>CB.normalWakeups=z>>CBZ.normalWakeups
	if cb>>CB.errorWakeups eq 0
	  then cb>>CB.errorWakeups=z>>CBZ.errorWakeups

	MoveBlock(lv (la>>DL.fileId), fileId, lFID)
	la>>DL.pageNumber=pageNumber
	cb>>CB.truePageNumber=pageNumber

	if DA ne fillInDA then cb>>CB.diskAddress=DA

	if action<<DC.seal ne DCactionSeal then SysErr(action, 1103)
	cb>>CB.command=action
	if exchangeDisks then cb>>CB.command.exchangeDisks=1
	cb>>CB.command.seal=diskCommandSeal

// QueueDiskCommand(cb) 
	DisableInterrupts()
	let p=nextDiskCommand-offset CB.nextCommand/16
	[ let np=p>>CB.nextCommand; if np eq 0 break; p=np ] repeat
	p>>CB.nextCommand=cb
// take care of possible race with disk controller
	if rv nextDiskCommand eq 0 then rv nextDiskCommand=cb
	EnableInterrupts()

	p=NextCb(z, CBZqueueTail)
	if rv p ne 0 then Bug(); rv p=cb
	]



and GetCb(zone, dontClear; numargs na)=valof [
	let t=NextCb(zone, CBZqueueHead)
	let cb=rv t; if cb eq 0 then Bug(); rv t=0
		[
		if (cb>>CB.status & DSdoneBits) ne 0 break
		if rv nextDiskCommand eq 0 & (cb>>CB.status &
		  DSdoneBits) eq 0 then ClearDiskError()
		vmask = DSdoneBits
		lvterminate = lv (cb >> CB.status);
		if vwaitproc then vwaitproc();
		] repeat

// remove seal
	cb>>CB.command.seal=DCactionSeal

// this is the test for errors
	let s=cb>>CB.status & DSgoodStatusMask
	test s eq DSgoodStatus
	  ifso [
		t=zone>>CBZ.cleanupRoutine
		if t ne 0 then t(cb)
		unless cb>>CB.diskAddress.restore do
		  [ zone>>CBZ.errorCount=0
			zone>>CBZ.currentNumChars=cb>>CB.labelAddress>>DL.numChars
			] 
		unless na ge 2 & dontClear do Zero(cb, lVarCB)
		resultis cb
		]
	  ifnot if s eq DSfreeStatus then [
		Zero(cb, lVarCB); resultis cb
		]

// we should discriminate among the various kinds of error
	[ if rv nextDiskCommand eq 0 break ] repeat
	unless s<<DS.dataLate do zone>>CBZ.errorCount=zone>>CBZ.errorCount+1
	let ec=zone>>CBZ.errorCount
	if ec ge maxEC then [
// unrecoverable error
// temporary code
		SysErr(0, 1101, cb)
		]

	let r=cb>>CB.retry
	let DA=cb>>CB.diskAddress
// ** Added for ScanPages - TJM ***
	if (zone >> CBZ.errorRoutine ne 0) then
		(zone >> CBZ.errorRoutine)(zone)
// **
	InitializeCbStorage(zone, zone>>CBZ.length,
	  cb>>CB.truePageNumber, r, false)
	if ec ge restoreEC then [
	  DA<<DA.restore=1
	  DA<<DA.track = 0
	  DoDiskCommand(GetCb(zone), 0, DA, 0, cb>>CB.truePageNumber, DCseekOnly)
	  ]
	ReturnTo(r)

	]


// this should never be called if there is only one process
and ClearDiskError(zone) be Bug()


let GetNextDA(cb) be [
	  let t=lv ((cb>>CB.zone>>CBZ.DAs)!(cb>>CB.truePageNumber+1))
	  if rv t eq fillInDA then rv t=cb>>CB.labelAddress>>DL.next
	  ]

and ActOnPages(CAs, DAs, fileId, firstPage, lastPage, action,
  lvNumChars, lastAction, fixedCA, cleanupRoutine; numargs na)=
  valof [
// 	let starttime = vec 2
// 	TIMER(starttime)
	let dummy=nil
	DefaultArgs1(lv na, -6, lv dummy, action, 0 ,GetNextDA)

	let zone=vec CBzoneLength
	let result = nil
	InitializeCbStorage(zone, CBzoneLength, firstPage,
	  Aretry, true)
	zone>>CBZ.DAs=DAs
	zone>>CBZ.cleanupRoutine=cleanupRoutine

Aretry:	[
// Note that each cb is used twice:  to hold the DL for
// page i-1, and then to hold the DCB for page i.  It isn't
// reused until the command for page i is done, and that is
// guaranteed to be after the DL for page i-1 is no longer
// needed, since everything is done strictly sequentially by
// page number.
	  let cb=GetCb(zone)
	result = lastPage

	  for i=zone>>CBZ.currentPage to lastPage do [
	    if DAs!i eq eofDA then
		[ result = i-1
		break;
		] 
	    let a=action; if i eq lastPage then a=lastAction
	    if a eq DCdoNothing then loop

	    let nextCb=GetCb(zone)

	    cb>>CB.labelAddress=((DAs!(i+1) eq fillInDA) ?
		lv nextCb>>CB.diskAddress, lv nextCb>>CB.label)

	    DoDiskCommand(cb, (CAs eq 0 ? fixedCA, CAs!i),
		DAs!i, fileId, i, a)
	    cb=nextCb
	    ]
	  while rv zone>>CBZ.queueHead ne 0 do GetCb(zone)
	  ]
	rv lvNumChars=zone>>CBZ.currentNumChars
// 	if vfloppy then
// 		waitforfd(DAs ! (-1),firstPage,lastPage,starttime);
	resultis result
	]

and RealDA(virtualDA)=valof [
// Div(x) returns virtualDA/x and leaves the remainder in virtualDA
	let Div=table [
    	  #55001		// sta 3 savedPC,2
	  #25004		// lda 1 firstArg,2
	  #155000		// mov 2 3
	  #111000		// mov 0 2
	  #102460		// mkzero 0 0
	  #61021		// div
	  #77400		// 77400
	  #171000		// mov 3 2
	  #45004		// sta 1 firstArg,2
	  #35001		// lda 3 savedPC,2
	  #1401			// jmp 1,3
	  ]

	let realDA=0
	realDA<<DA.sector=Div(nSectors)
	realDA<<DA.head=Div(nHeads)
	realDA<<DA.track=Div(nTracks)
	realDA<<DA.disk=virtualDA
	resultis realDA
	]