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