// PDInstallUtils.bcpl -- PDPrint installation utilities
// derived from PressInitUtils 2/7/83

//  errors 280

get "PDInternals.d"
get "AltoFileSys.d"
get "Disks.d"
get "Streams.d"
get "SysDefs.d"
get "IfsIsf.d"

structure BFSDSK:  
 [	@DSK
	@KDH
	//other stuff not used here....
 ]
structure KD:
[
@KDH			//Header part
diskBitTable ^1,1 word	//The bit table itself (1,1 means nothing)
]

// outgoing procedures
external
	[
	IndexFile
	GetFileStatic
	SetupDrive1
	CloseDrive1
	]

// outgoing statics
//external
//	[
//	]
//static
//	[
//	]

// incoming procedures
external
	[
//PDPRINT
	PDError
	DblShift

//PDML
	DoubleAdd
	Ugt

//Used for initialization of files, etc. -- removed by Junta
	OpenFile
	DeleteFile
	Closes
	ReadBlock
	WriteBlock
	FileLength
	GetCompleteFa
	Resets
	PositionPage
	ReadLeaderPage
	WriteLeaderPage

//WINDOW
	WindowInit
	WindowClose
	WindowWriteBlock

//SCANSTRINGS
	TypeForm
	ReadNumber

//ALLOC
	Allocate

//OS
	MoveBlock
	Zero
	ActOnDiskPages
	ReturnFrom
	BFSClose
	BFSInit

//TFS
	TFSInit
	ReleaseDiskPage
	AssignDiskPage

//DiskFindHole
	DiskFindHole

//IfsIsf
	InitFmap; IndexedPageIO; LookupFmap;
	]

// incoming statics
external
	[
	BitsFile
	ScratchFile
	LeftOverFile1
	LeftOverFile2
	MeterFile
	PDFile
	RunFile
	tridentVec
	tridentUsed

	sysDisk
	PDZone
	]

// internal statics
static
	[
	drive1disk
	]

// File-wide structure and manifest declarations.

structure STR[
	length byte
	char^1,255 byte
	]

// Procedures

//----------------------------------------------------------------------------
let IndexFile(p, findex, givenFileName; numargs na) = valof
//----------------------------------------------------------------------------
//Index a file: (called from above and PressInit)
//	p=vector in which to index
//	findex=index of file for the structure
[
// Get code for where to look (0= main Model 31 disk, 1=alternate disks, then main Model 31)
	let where=GetFileWhere(findex)

// Alter=0 (RO,silent), 1 (RO,print), 2 (RW,print)
	let alter=GetFileType(findex)
	let filetype=(alter eq 2)? FILERW,FILERO

//Now index the file 
	let str=vec 20
	let fname=vec 20
	let s=0
	let disk=nil
	let bestDisk=nil

	[ //giant loop, deleting all inappropriate versions of file

	//first, find most likely file
	for i=(where? (2+NTridentDrives*NPartitions-1),0) to 0 by -1 do
	 [ disk=DiskStuff(i, 2)
	   if disk eq 0 then loop
	   for j=0 to 1 do //try PDPrint.xxx and Press.xxx
		[
		test findex eq FILEPD then
		[ fname=givenFileName
		  if j eq 1 then loop	 ] or		//No need to look twice for pd file
		[ fname>>STR.length=0
		  if j eq 1 & findex eq FILEPDProgram then loop	//Don't get Press.run
		  test j eq 0 then AppendStr(fname,"PDPrint.") or
		   AppendStr(fname,"Press.")
		  AppendStr(fname,GetFileExtension(findex)) ]
		s=OpenFile(fname,ksTypeReadOnly,0,0,0,0,PDZone,0,disk)
		bestDisk=i
		if s ne 0 then break
		]
	   if s ne 0 then break
	 ] //end of "find most likely file"

	if alter eq 0 & s eq 0 then resultis 0	//Error

//Remake proper file name if it wasn't found
	if s eq 0 then
		[
		fname>>STR.length=0
		AppendStr(fname,"PDPrint.")
		AppendStr(fname,GetFileExtension(findex))
		]
	if alter then TypeForm("File: ", fname)
	if alter ne 0 test s ne 0 then
	   [
	   TypeForm(" on ",DiskStuff(bestDisk, 0))
	   let v=vec 1
	   FileLength(s, v)
	   DblShift(v, disk>>DSK.lnPageSize+1)
	   TypeForm(", length is ",10,v!1," pages.")
	   test alter eq 2 then
		 [	TypeForm(" Ok?",1,str)
			let c=str>>STR.char^1
			if str>>STR.length ne 0 & (c eq $n % c eq $N) then
			 [ Closes(s)
				if fname>>STR.char^2 ne $r then //don't delete Press.xxx
					DeleteFile(fname, 0, 0, PDZone, 0, disk)
				s=0
			 ]
		 ] 
		or TypeForm(0)
	   ] 
	or TypeForm(" -- does not exist.*n")

 	//now, decide if we're done with giant loop
	if s ne 0 then break	//found it!!!
	if bestDisk eq 0 then break	//nowhere!!!
 ] repeat //end of giant loop, either choosing file, or deleting all versions

	if s eq 0 then
	 [ for i=2+NTridentDrives*NPartitions-1 to 0 by -1 do if DiskStuff(i, 2) then
		 [ TypeForm("Do you want it on the ",DiskStuff(i, 0),"?",1,str)
			let c=str>>STR.char^1
			if str>>STR.length ne 0 & (c eq $n % c eq $N) then loop
			bestDisk=i
			break
		 ] //end of for i=2+NTridentDrives*NPartitions-1 to 0 loop

	   disk=DiskStuff(bestDisk, 2)
	   TypeForm("How long do you want it to be (in pages): ",1,str)
	   let pagcnt=ReadNumber(str)
	   if bestDisk ge 2 then
		 [ let bVDA=DiskFindHole(disk,pagcnt+2)	//1 for leader, 1 for numchrs=0
			if bVDA eq -1 then
			 [ TypeForm("Unable to find contiguous hole that size on the disk!  Try again.*n")
				loop
			 ]
			ReleaseDiskPage(disk,
			  AssignDiskPage(disk,bVDA-1))
		 ]
	   s=OpenFile(fname,ksTypeWriteOnly,0,0,0,0,PDZone,0,disk)
	   if bestDisk ge 2 then
		 [ ReadLeaderPage(s, p)
			p>>LD.consecutive=true
			WriteLeaderPage(s, p)
		 ]
	   // Because of bug in TransferPages, go slowly:
	   let cp=0
	   while cp ne pagcnt+1 do
		 [ let toPage=pagcnt+1
			if Ugt(toPage-cp, 200) then toPage=cp+200
			PositionPage(s, toPage)
			cp=toPage
		 ]
	   break					//Normal case -- done
	  ] repeat	//keep going until you find a contiguous hole

	let consecutive=false
	ReadLeaderPage(s, p)
	if p>>LD.consecutive then consecutive=true	//Believe the hint!!!

	Zero(p,3000)
	Resets(s)
	let cfa=vec lCFA
	GetCompleteFa(s, cfa)
	p>>F.version=cfa>>CFA.fp.version
	MoveBlock(lv p>>F.serialNumber, lv cfa>>CFA.fp.serialNumber, lSN)

   //Compute number of pages included in FileLength:
   let lnPageSize = disk>>DSK.lnPageSize;  // log of words per page
   let fileLength = vec 1; FileLength(s, fileLength);  // length in bytes
   let pageCount = vec 1;
   pageCount!0 = 0;
   pageCount!1 = 1 lshift (lnPageSize + 1) - 1;  // i.e. bytes per page - 1
   DoubleAdd(pageCount, fileLength);  // round up to next page boundary
   DblShift(pageCount, lnPageSize + 1);
   p>>F.Pagecnt = pageCount!1;

	Closes(s)

   let plen = nil;  // length of this F

   test consecutive
      ifso
         [
         p>>F.DAFirst = cfa>>CFA.fa.da;  // DA for first data page.
         plen = (offset F.fmap / 16);  // length is just length of F
         ]
      ifnot
         [
         let fmap = lv p>>F.fmap;
         let initOK = InitFmap(fmap, 3000 - offset F.fmap / 16,
          lv cfa>>CFA.fp, 0, 10, -1, disk);
         if initOK then
            [
            let page = vec 1024;
            IndexedPageIO(fmap, p>>F.Pagecnt, page, 1, 0);
            ]
         let lastDA = LookupFmap(fmap, p>>F.Pagecnt, true);
         unless initOK & lastDA ne fillInDA do
            [
            TypeForm("This non-consecutive file cannot be used by PDPrint.*n");
            resultis 0;
            ]
         let last = fmap>>FM.last; fmap>>FM.end = last;
         plen = lv fmap>>FM.fmap!last + lenMapEntry - p;  // include fmap
         ]


//*******************************************************
//********** remove this when file stuff rationalized ***********
//Special treatment for bits file -- always make it look like 1024 word pages
	if findex eq FILEBits then
		[
		p>>F.Pagecnt=p>>F.Pagecnt rshift (10-lnPageSize)
		lnPageSize=10
		]

	p>>F.Name=findex
	p>>F.Device=DiskStuff(bestDisk, 1)
	p>>F.Pagesize=1 lshift lnPageSize
	p>>F.LogPagesize=lnPageSize
	p>>F.Type=filetype

	resultis plen
]

//----------------------------------------------------------------------------
and DiskStuff(i, what) = 
//----------------------------------------------------------------------------
  selecton what into
	 [ case 0:	selecton i into 
		 [		//Names
			case 0:  "Model 31"
			case 1:  "Model 31, drive 1"
			default: valof
			 [ let tString="Trident drive x, filesys x"
				tString>>STR.char^15=$0+NTridentDrives-1-((i-2)/NPartitions)
				tString>>STR.char^26=$0+NPartitions-1-((i-2) rem NPartitions)
				resultis tString
			 ]
		 ] //end of names
		case 1:	i	//PD code
		case 2:	selecton i into
		 [		//"disk" structures
			case 0: sysDisk
			case 1: drive1disk
			default: tridentVec!(i-2)
		 ]
	]

// Set up for dealing with second Model 31 drive, if it is there.

//----------------------------------------------------------------------------
and SetupDrive1() = valof
//----------------------------------------------------------------------------
[
drive1disk = BFSInit(PDZone, true, 1);
resultis drive1disk
]

//----------------------------------------------------------------------------
and CloseDrive1() be
//----------------------------------------------------------------------------
[
if drive1disk then drive1disk = BFSClose(drive1disk);
]

//----------------------------------------------------------------------------
and GetFileExtension(findex) = (
//----------------------------------------------------------------------------
   selecton findex into
	[
	case FILEBits:		"Bits"
	case FILEScratch:	"Scratch"
	case FILELeftOver1:	"LO1"
	case FILELeftOver2:	"LO2"
	case FILEMeter:		"Meter"
	case FILEPDProgram:	"Run"
	default:		PDError(280)
	]
)


//----------------------------------------------------------------------------
and GetFileType(findex) = (
//----------------------------------------------------------------------------
   selecton findex into
	[
	case FILEPD:		0	//Read-only, silent
	case FILEPDProgram: 1	//Read-only, print it out
	default:		2	//Read-write, print it out
	]
)

//----------------------------------------------------------------------------
and GetFileWhere(findex) = (
//----------------------------------------------------------------------------
   selecton findex into
	[
	case FILEPDProgram:	0
//	case FILEPD:
	default:		1
	]
)

//----------------------------------------------------------------------------
and GetFileStatic(findex) = (
//----------------------------------------------------------------------------
   selecton findex into
	[
	case FILEBits:		lv BitsFile
	case FILEScratch:	lv ScratchFile
	case FILELeftOver1:	lv LeftOverFile1
	case FILELeftOver2:	lv LeftOverFile2
	case FILEMeter:		lv MeterFile
	case FILEPDProgram:	lv RunFile
	default:		PDError(280)
	]
)

//----------------------------------------------------------------------------
and AppendStr(s1, s2) be
//----------------------------------------------------------------------------
[
	for i=1 to s2>>STR.length do
		[
		let j=s1>>STR.length+1
		s1>>STR.length=j
		s1>>STR.char^j=s2>>STR.char^i
		]
]