// BFS Write
// New Alto basic file system

// Last modified September 25, 1982  3:04 PM by Taft

get "altofilesys.d"

// 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
	vwaitproc;
	vSkfd
	nTracks
	nSectors
	nDisks
	nHeads
	]

// incoming procedures
external [
	Zero; MoveBlock
	errhlta
	ReturnTo
	DefaultArgs1
	DisableInterrupts; EnableInterrupts
	enqueue;
	divmod;
	ReadDiskKd;
	WriteDiskKd;
	]

// incoming statics
external [
	oneBits
	freePageId
	ccycles;
	centries;
// 	dnbp
	diskKd;
	crefKd;
	]

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

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

// Incoming statics
external [
	bpsrcqueue;vfpfirst;rgbpfs
	vmacfc;
	vmask; lvterminate
	rglastused
	abs; vfloppy;
	curfda; vcwaitfd;ugt
	vpgpertrk; vmsskpertrk; vmsheadld; vmstransperpg;
	TIMER
	]

manifest [
	allOnes=#177777
	wordLength=16
	wordsPerPage=#400; charsPerPage=wordsPerPage*2
	]

structure FDA:
	[
	track	bit	13;
	sector	bit	3;
	] 

structure SKFD:
	[
	cTrkBump↑0,1	word;
	cSeek↑0,1	word;
	cpgTrans↑0,1	word;
	] 

// Bravo "knows" that the bit table immediately follows the KDH structure.
// Warning: a copy of this structure lives in KD.sr.
structure KD:
	[
		[
		@KDH
		diskBitTable word 0
		] =
		[
		blank word (offset KDH.lastSn + size KDH.lastSn)/16
		bitTableChanged word  // pre-OS18 convention, which Bravo still uses
		]
	]

get "BFS.DEF"

// the actions which are needed by callers of bfs are (external)
manifest [
	DCreadLabel=diskCheck*DCheaderx+diskRead*(DClabelx+DCdatax)+DCaS
	]



// FLOPPY DISK WAIT

// and waitforfd(fdaoffile,firstPage,lastPage,starttime,fdnum; numargs na) be
// [ 
// if na ls 5 then fdnum=0
// let fdafirst = fdaoffile+firstPage
// let fdalast = fdaoffile+lastPage
// let tnil = nil
// let curtrk = divmod(curfda,vpgpertrk,lv tnil);
// let firsttrk = divmod(fdafirst,vpgpertrk,lv tnil);
// let lasttrk = divmod(fdalast,vpgpertrk,lv tnil);
// let dTrkSeek = abs(curtrk-firsttrk)
// let dTrkBump = abs(lasttrk-firsttrk)
// unless dTrkSeek eq 0 then
// 	[ vSkfd >> SKFD.cTrkBump↑fdnum = vSkfd >> SKFD.cTrkBump↑fdnum+dTrkSeek
// 	vSkfd >> SKFD.cSeek↑fdnum = vSkfd >> SKFD.cSeek↑fdnum+1
// 	] 
// vSkfd >> SKFD.cpgTrans↑fdnum = vSkfd >> SKFD.cpgTrans↑fdnum+ (lastPage-firstPage+1)
// vSkfd>>SKFD.cTrkBump↑fdnum=vSkfd>> SKFD.cTrkBump↑fdnum+dTrkBump
// let msseek = dTrkSeek*vmsskpertrk
// let mstransfer = (lastPage-firstPage+1)*vmstransperpg
// let msbumptrack = dTrkBump*vmsskpertrk
// let mslatency = ((vpgpertrk*vmstransperpg) rshift 1)+vmsheadld;
// curfda = fdalast;
// let mstot = (msseek+mslatency+mstransfer+msbumptrack)
// let ttime = vec 2;
// 	[ TIMER(ttime)
// 	vcwaitfd = vcwaitfd+1
// 	] repeatuntil ugt(ttime ! 1-starttime ! 1,mstot)
// ] 

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

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

ReadDiskKd()

	  [
	  let sink=vec #400
	  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

WriteDiskKd();

// all the pages have been checked.  Write labels and data
// 	let starttime = vec 2
// 	TIMER(starttime)
	[
	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)
	]
// 	if vfloppy then
// 		waitforfd(DAs ! (-1),firstPage,lastPage,starttime);
	resultis lastPage
	]



and AssignDiskPage(realPrevDA)=valof [
ReadDiskKd()
	let base=VirtualDA(realPrevDA)+1
	let baseWa=base<<wordAddr; let baseBa=base<<bitAddr
	let diskBitTable = lv (diskKd >> KD.diskBitTable)
	let diskBTsize = diskKd >> KD.diskBTsize;
	let tda = nil;
	  [
	  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
			tda =  RealDA(wa*wordLength+ba)
			goto Assigned
			]
		baseBa=0
		]
	  if baseWa eq 0 then [ errhlta(249) ] repeat
	  baseWa=0
	  ]
	repeat
Assigned:
	diskKd >> KD.bitTableChanged = true;
WriteDiskKd();
resultis tda
	]

and ReleaseDiskPage(realDA) be [
ReadDiskKd()
	let v=VirtualDA(realDA); let wa=v<<wordAddr
	let diskBitTable = lv (diskKd >> KD.diskBitTable)
	diskBitTable!wa=diskBitTable!wa & not oneBits!(v<<bitAddr)
	diskKd >> KD.bitTableChanged = true;
WriteDiskKd();
	]


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


and Bug(a, b, c) be errhlta(247)


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

// outgoing procedures
external [
	CreateFile
	DeletePages
	NextSn
	MakeFileId
	]

// incoming procedures
external [
	SetBlock
	ReadCalendar
	]

// 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
	leaderVirtualDa word
	]
manifest lFP=size FP/16

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


// 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 NextSn(snDest) be
[ ReadDiskKd()
let lastSN = lv (diskKd >> KD.lastSn)
let t=lastSN>>SN.part2+1; lastSN>>SN.part2=t
if t eq 0 then lastSN>>SN.word1=lastSN>>SN.word1+1
MoveBlock(snDest, lastSN, 2)
diskKd >> KD.bitTableChanged = true;
WriteDiskKd();
] 

and CreateFile(name, filePtr, b) be [
	Zero(filePtr, lFP)
	Zero(b, wordsPerPage)
	NextSn(lv filePtr>>FP.serialNumber)
	filePtr>>FP.version=1
	let fid=vec lFID; MakeFileId(fid, filePtr)
	ReadCalendar(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.leaderVirtualDa=VirtualDA(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
	]