// BFS
// New Alto basic file system


// Outgoing procedures
external [
	InitializeCbStorage; DoDiskCommand; GetCb
	ActOnPages; WritePages
	Bug
	]

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

// incoming procedures
external [
	Zero; MoveBlock
	errhlt; SYSERR
	ReturnTo
	DefaultArgs1
	DisableInterrupts; EnableInterrupts
	]

// incoming statics
external [
	oneBits
	freePageId
	]

// declarations for the disk allocation bit table
// the DA structure declaration is also used

// Outgoing procedures
external [
	AssignDiskPage; ReleaseDiskPage
	RealDA; VirtualDA
	]

// Incoming statics
external [
	diskBitTable; diskBTsize
	]


manifest [
	nTracks = 203;
	nHeads = 2;
	nSectors = 12;
	msb=#100000
	allOnes=#177777
	wordLength=16
	]
structure [ wordAddr bit 12; bitAddr bit 4 ]

manifest [ wordsPerPage=#400; charsPerPage=wordsPerPage*2 ]

manifest lFID=3


// disk data structures, transcribed from osstructures

// page 1 locations
manifest [
	nextDiskCommand = #521		// pointer to DCB
	diskStatus = #522		// @DS
	lastDiskAddress = #523		// @DA
	sectorInterrupts = #524
	]

// disk address
structure DA[
	sector bit 4
	track bit 9
	head bit 1
	disk bit 1
	restore bit 1
	]

// disk header
structure DH[
	packId word
	diskAddress @DA
	]

// disk label. *=set by DoDiskCommand
structure DL[
	next word		// disk address of next file
				// page, or eofDA
	previous word		// disk address of previous
				// file page, or eofDA
	blank word
	numChars word		// between 0 and charsPerPage inclusive.
				// ne charsPerPage only on last page
	pageNumber word		// * leader is page 0, first data
				// page is page 1
	fileId word lFID	// *
	]
manifest lDL=size DL/16

// disk status word.  See hardware manual for detailed definitions
structure DS[
	sector bit 4
	done bit 4
	seekFailed bit
	seekInProgress bit
	notReady bit
	dataLate bit
	noTransfer bit
	checksumError bit
	finalStatus bit 2
	]

// disk command
structure DC[
	seal bit 8			// must be #110
	headerAction bit 2
	labelAction bit 2
	dataAction bit 2
	seekOnly bit 1
	exchangeDisks bit 1		// disk controller inverts
					// DCB.diskAddress if this bit 
					// is set
	]
manifest diskCommandSeal=#110
// possible disk actions in command word
manifest [ diskRead = 0; diskCheck = 1; diskWrite = 2]

// disk command block. *=set by DoDiskCommand, $=defaulted by
// DoDiskCommand if 0
structure DCB[
	nextCommand word	// *
	status @DS		// set when command is completed
	command @DC		// *
	headerAddress word	// * these are memory addresses
	labelAddress word	// $
	dataAddress word	// *
	normalWakeups word	// $
	errorWakeups word	// $
	header @DH =
		[
		blank word
		diskAddress @DA	// * if DA argument ne fillInDA
		]
	]
manifest lDCB=size DCB/16

// *=initialized by InitializeCbStorage; everything else is zeroed
structure CBZ[
	length word		// *
	DAs word
	cleanupRoutine word
	currentPage word	// * set only by InitCbStorage
	currentNumChars word
	normalWakeups word
	errorWakeups word
	errorCount word
	queueHead word		// * address of first entry
	queueTail word		// * address of last entry + 1
	endQueueVec word	// * address of first word beyond
	queueVec ↑ 0, 1000 word	// * contains one more entry than
				// there are cb's in the zone

	]
manifest [
	lCBZ=offset CBZ.queueVec/16+1
	CBZqueueHead=offset CBZ.queueHead/16
	CBZqueueTail=offset CBZ.queueTail/16
	]

// *=initialized by InitializeCbStorage; everything else is zeroed
structure CB[
// the DCB must come first
	@DCB			// a free CB must have
				// status=DSgoodStatus;
				// initialization leaves it
				// that way
	label @DL

	truePageNumber word
// 'variable' part of the cb ends here
	zone word		// *
	retry word		// *
	]
manifest [ lCB=size CB/16; lVarCB=offset CB.zone/16 ]

// normally we want room for 3 cb's in a zone
manifest CBzoneLength=lCBZ+3*(lCB+1)

manifest [
	DSerrorBits=msb rshift offset DS.seekFailed +
		    msb rshift offset DS.notReady +
		    msb rshift offset DS.dataLate +
	  	    msb rshift offset DS.checksumError +
		    (-(msb rshift (size DS.finalStatus-1)))
			rshift offset DS.finalStatus;
	DSdoneBits=(-(msb rshift (size DS.done-1)))
			rshift offset DS.done;
	DSgoodStatusMask=DSerrorBits % DSdoneBits;
// good status means that all the error bits are 0
	DSgoodStatus=DSdoneBits
	DSfreeStatus=msb rshift (offset DS.done+size DS.done-1)
	]


// disk command actions
manifest [
 DCheaderx=msb rshift (offset DC.headerAction+size DC.headerAction-1)
 DClabelx=msb rshift (offset DC.labelAction+size DC.labelAction-1)
 DCdatax=msb rshift (offset DC.dataAction+size DC.dataAction-1)
	]

manifest [
	DCactionSeal=#321
	DCaS=DCactionSeal*(msb rshift (offset DC.seal+size DC.seal-1))
	]
// 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,1000)
	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()
		] repeat

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

// 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)
		zone>>CBZ.currentNumChars=cb>>CB.labelAddress>>DL.numChars
		unless cb>>CB.diskAddress.restore do
		  zone>>CBZ.errorCount=0
		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
	let ec=zone>>CBZ.errorCount+1; zone>>CBZ.errorCount=ec
	if ec ge maxEC then [
// unrecoverable error
// temporary code
		SYSERR(cb, 1001)
		]

	let r=cb>>CB.retry
	let DA=cb>>CB.diskAddress
	InitializeCbStorage(zone, zone>>CBZ.length,
	  cb>>CB.truePageNumber, r, false)
	if ec ge restoreEC then [
	  DA<<DA.restore=1
	  DoDiskCommand(GetCb(zone), 0, DA, 0, 0, DCseekOnly)
	  ]
	ReturnTo(r)

	]


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



// returns the page number of the last page successfully acted
// on.
// CAs (core addresses) and DAs (disk addresses) are vectors
// indexed by page number (e.g. CAs!firstPage)
// the arguments following action are optional; if one of them is
// omitted or 0, the default action is taken
and ActOnPages(CAs, DAs, fileId, firstPage, lastPage, action,
  lvNumChars, lastAction, fixedCA, cleanupRoutine; numargs na)=
  valof [
	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
	  ]

	let dummy=nil
	DefaultArgs1(lv na, -6, lv dummy, action, 0 ,GetNextDA)

	let zone=vec CBzoneLength
	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)

	  for i=zone>>CBZ.currentPage to lastPage do [
	    if DAs!i eq eofDA then
		[ lastPage = 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
	resultis lastPage
	]



// note that DAs!(firstpage-1) will be referenced if DAs!firstPage
// eq fillInDA or eofDA, and that DAs!(lastPage+1) will be set to
// eofDA except when the label of lastPage doesn't need to be
// rewritten
// the arguments following lastPage are optional, as for ActOnPages
and WritePages(CAs, DAs, fileId, firstPage, lastPage, lastAction,
  lvNumChars, lastNumChars, fixedCA; numargs na)=valof [
	let CheckFreePage(cb) be [
	  let fid=lv cb>>CB.labelAddress>>DL.fileId
	  for i=0 to lFID-1 do if fid!i ne freePageId!i then
	    (cb>>CB.zone>>CBZ.DAs)!(cb>>CB.truePageNumber)=fillInDA
	  ]

	let numChars=nil; let firstNewPage=nil
	DefaultArgs1(lv na, 5, 0, 0, charsPerPage, 0)
	if lastAction eq 0 then lastAction=DCwrite
	if lvNumChars eq 0 then lvNumChars=lv numChars

// first proceed as for a read until there are no more
// preallocated pages to write into
	test DAs!firstPage eq fillInDA
	  ifso firstNewPage=firstPage
	  ifnot [
		firstPage=ActOnPages(CAs, DAs, fileId, firstPage,
		  lastPage, DCwrite, lvNumChars, lastAction,
		  fixedCA)
		if firstPage eq lastPage & (lastAction ne DCwrite %
		  rv lvNumChars eq lastNumChars) then
			resultis lastPage
		firstNewPage=firstPage+1
		]

// code to assign more pages
// set up eofDA as the page after the end of the file

	  [
	  let sink=vec wordsPerPage
	  for i=firstNewPage to lastPage do
		DAs!i=AssignDiskPage(DAs!(i-1))
	  let j=ActOnPages(0, DAs, freePageId, firstNewPage,
	    lastPage, DCreadLabel, 0, 0, sink, CheckFreePage)
	  for i=firstNewPage to lastPage do [
		DAs!firstNewPage=DAs!i
		if DAs!i ne fillInDA then
		  firstNewPage=firstNewPage+1
		]
	  if firstNewPage gr lastPage then break
	  ]
	repeat

// all the pages have been checked.  Write labels and data
	[
	let zone=vec CBzoneLength;
	InitializeCbStorage(zone, CBzoneLength, firstPage,
	  Wretry, true)
Wretry:	for i=zone>>CBZ.currentPage to lastPage do [
		let cb=GetCb(zone)
		cb>>CB.label.next=((i eq lastPage & lastNumChars ne charsPerPage) % (DAs ! (i+1) eq fillInDA) ? 0,DAs!(i+1))
		cb>>CB.label.previous=DAs!(i-1)
		cb>>CB.label.numChars=(i eq lastPage ?
		  lastNumChars, charsPerPage)
		DoDiskCommand(cb, (CAs eq 0 ? fixedCA, CAs!i),
		  DAs!i, fileId, i, DCwriteLabel)
		]
	while rv zone>>CBZ.queueHead ne 0 do GetCb(zone)
	]
	resultis lastPage
	]



and AssignDiskPage(realPrevDA)=valof [
	let base=VirtualDA(realPrevDA)+1
	let baseWa=base<<wordAddr; let baseBa=base<<bitAddr

	  [
	  for wa=baseWa to diskBTsize-1 do [
		let w=diskBitTable!wa
		if w ne allOnes then for ba=baseBa to wordLength-1 do
		  if (w & oneBits!ba) eq 0 then [
			diskBitTable!wa=w % oneBits!ba
			resultis RealDA(wa*wordLength+ba)
			]
		baseBa=0
		]
	  if baseWa eq 0 then [ errhlt("Disk full") ] repeat
	  baseWa=0
	  ]
	repeat
	]

and ReleaseDiskPage(realDA) be [
	let v=VirtualDA(realDA); let wa=v<<wordAddr
	diskBitTable!wa=diskBitTable!wa & not oneBits!(v<<bitAddr)
	]


and VirtualDA(realDA)=((realDA<<DA.disk*nTracks+realDA<<DA.track)*
	nHeads+realDA<<DA.head)*nSectors+realDA<<DA.sector


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
	]

and Bug(a, b, c) be errhlt("Bug")


 // Stuff supplied by bfs
// manifest [ wordsPerPage=#400; charsPerPage=wordsPerPage*2 ]
// manifest [ lFID=3 ]

// outgoing procedures
external [
	CreateFile
	DeletePages
	]

// incoming procedures
external [
	SetBlock
	]

// incoming statics
external [
	lastSN
	]

// Miscellaneous declarations
structure STRING[ length byte; body ↑ 1,255 byte ]
structure TIME[ blank word 2 ]
manifest lTIME=size TIME/16

// serial number
structure SN[
		[
		directory bit 1
		random bit 1
		part1 bit 14
		]
	= word1 word
	part2 word
	= word2 word
	]
manifest lSN=size SN/16

// file identifier
structure FID[
	version word
	serialNumber @SN
	]


// file pointer
structure FP[
	serialNumber word lSN
	version word
	blank word
	leaderDA word
	]
manifest lFP=size FP/16

// leader page
structure LD[
	blank word 6
	name @STRING
	fileId word lFID
	created @TIME
	read @TIME
	written @TIME
	]


// the following stuff doesn't have anything to do with disk
// streams.  It performs file-related functions which are 
// somewhat higher-level than ActOnPages and WritePages


let MakeFileId(fid, filePtr) be [
	MoveBlock(lv fid>>FID.serialNumber,
	  lv filePtr>>FP.serialNumber, lSN)
	fid>>FID.version=filePtr>>FP.version
	]



and CreateFile(name, filePtr) be [
	Zero(filePtr, lFP)
	let b=vec wordsPerPage; Zero(b, wordsPerPage)
	let t=lastSN>>SN.part2+1; lastSN>>SN.part2=t
	if t eq 0 then lastSN>>SN.word1=lastSN>>SN.word1+1
	MoveBlock(lv filePtr>>FP.serialNumber, lastSN, 2)
	filePtr>>FP.version=1
	let fid=vec lFID; MakeFileId(fid, filePtr)
	Daytime(lv b>>LD.created)
	MoveBlock(lv b>>LD.written, lv b>>LD.created, lTIME)
	MoveBlock(lv b>>LD.read, lv b>>LD.created, lTIME)
	for i=0 to name>>STRING.length rshift 1 do 
		(lv b>>LD.name)!i=name!i

	let DAs=vec 4; DAs=DAs+1; DAs!(-1)=eofDA; DAs!0=fillInDA
	WritePages(0, DAs, fid, 0, 1, 0, 0, 0, b)
	filePtr>>FP.leaderDA=DAs!0
	]


// delete pages starting at firstDA and continuing to the end of
// the file.  CA is a page-size buffer which is zeroed
and DeletePages(CA, firstDA, fileId, firstPage) be
  while firstDA ne eofDA do [ 
	manifest biteSize=128; let DAs=vec biteSize
	SetBlock(DAs, fillInDA, biteSize+1)
	DAs=DAs-firstPage; DAs!firstPage=firstDA

	let lastPageFound=ActOnPages(0, DAs, fileId, firstPage,
	  firstPage+biteSize-1, DCread, 0, 0, CA)

	Zero(CA, wordsPerPage)
	ActOnPages(0, DAs, freePageId, firstPage,
	  lastPageFound, DCwriteLabel, 0, 0, CA)
	for i=firstPage to lastPageFound do ReleaseDiskPage(DAs!i)

	firstPage=lastPageFound+1; firstDA=DAs!firstPage
	]


// dummy version of a routine which will someday be part of the
// operating system
and Daytime(v) be [ v!0=0; v!1=0 ]