//TFU.bcpl
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified July 9, 1981 1:27 PM by Taft
//TFU ERASE cylinders
// Cylinders optional, default is entire disk
//TFU COPY file/C ← file
// (/C means consecutive)
//TFU RENAME newFile ← oldFile
//TFU DELETE file1 file2 ...
//TFU DIRECTORY/V file
// File is optional; /V means verbose.
// If no file, uses display
//TFU ADDRESS file
// Prints out logical disk addresses of the file
//TFU CREATEFILE file pages
// Makes it contiguous
//TFU CERTIFY passes
// Tests the disk looking for bad spots and records any that it finds
// in the bad spot table on the pack
//TFU BADSPOTS
// Lists out the bad spot table
//TFU RESETBADSPOTS
// Resets the bad spot table
//TFU DRIVE TPn
// Sets drive number to use for remainder of command
//TFU EXERCISE <number of passes> <list of drives>
//TFU CONVERT
// Converts DiskDescriptor from format version 1 to version 2
// "|" with spaces on both sides terminates commands that take
// an indefinite number of arguments.
//File syntax:
// TPn:file -- Trident disk file on drive n
// DP0:file -- Diablo disk file
// file -- Trident file on default drive
// All display typeout is also sent to TFU.log.
get "AltoFileSys.d"
get "Disks.d"
get "Tfs.d"
get "Streams.d"
get "AltoDefs.d"
external
[
//TFU -- export
InitDisk
ConfirmWipe
//TFUutils
ReadToken
BackToken
Disambiguate
ReadFile
ReadDrive
StrEq
ReadNumber
Switch
Error
RunEther
InitLog
CloseLog
BigDisplay; SmallDisplay
ReportDebugStats
//TFS
TFSInit
TFSClose
TFSSilentBoot
TFSSwatContextProc
TFSDebug
//TFSExercise
Exercise
//TFUConvert
TFUConvert
//TFUCertify
CertifyPack
ListBadSpots
ResetBadSpots
//TFSNEWDISK
TFSNewDisk
//DISKFINDHOLE
DiskFindHole
//GP
SetupReadParam
ReadParam
//RenameFile
RenameFile
//Template
PutTemplate
//BcplRuntime
InitBcplRuntime
//OS
lvUserFinishProc
sysDisk
InitializeZone
OpenFile
CreateDiskStream
DeleteFile
FindFdEntry
GetCompleteFa
FileLength
DoubleAdd
Resets
ReadBlock
WriteBlock
Closes
PositionPage
ReadLeaderPage
WriteLeaderPage
MoveBlock
Zero; SetBlock
Wss; Wns; Wo
Ws; Gets; keys; dsp; Idle; lvIdle; lvCursorLink; lvSwatContextProc
CreateDisplayStream; ShowDisplayStream
MyFrame
AltoVersion
StartIO
AssignDiskPage; ReleaseDiskPage
//RAM stuff
LoadRam; DiskRamImage
// incoming statics
lastToken
TFSLeaveDisplay
TFSSavedDisplay
// outgoing statics
z
str
sw
defaultDrive
dMachine
noConfirm
]
static
[
str //String from ReadParam
sw //Switches from ReadParam
z //Zone for everything
defaultDrive
scratchVec
savedUFP; saveIdle; saveSCP
mpDriveDisk //map of inited disks
noConfirm = false
dMachine = false
]
manifest nDrives = 8 //physical drives
manifest nDisks = 3*nDrives //disk structures
//----------------------------------------------------------------------------
let TFU() be
//----------------------------------------------------------------------------
[
InitLog()
Ws("TFU 1.29 July 9, 1981*n")
dMachine = AltoVersion<<VERS.eng ge 4 // Dolphin=4, Dorado=5
unless dMachine do
[
let a=LoadRam(DiskRamImage, true)
if a ls 0 then Error("The machine has no RAM and/or no Ethernet board.*n")
InitBcplRuntime()
]
savedUFP=@lvUserFinishProc
@lvUserFinishProc=TFUFinish
@#335=LoadRam
saveIdle = @lvIdle
Idle = TFUIdle
@lvIdle = TFUIdle
@lvCursorLink = false
saveSCP = @lvSwatContextProc
@lvSwatContextProc = TFSSwatContextProc
Zero(KBLK, 6)
// init drive selection information
let lmp=vec nDisks
Zero(lmp, nDisks)
mpDriveDisk=lmp
defaultDrive=0
// switch and string accumulation vectors
let lstr=vec 128
let lsw=vec 26
let lscr=vec 1024
str=lstr; sw=lsw; scratchVec= lscr
SetupReadParam(str,sw)
if Switch($D) then TFSLeaveDisplay=true //Leave display
if Switch($E) then RunEther() //Run Ether
let checkIt=0
if Switch($C) then checkIt=2 //Check data
if Switch($W) then checkIt=1 //Just write consistent data
noConfirm = Switch($N) // No confirmations required
if Switch($R) & TFSDebug then
[ // buffer for RecordTFS (iff TFSBase compiled w/ debug=true)
let recordBuf = @#335; @#335 = recordBuf+106B+20*3
SetBlock(recordBuf, -1, 106B+20*3)
recordBuf!0 = recordBuf+6
recordBuf!1 = recordBuf+106B
recordBuf!2 = recordBuf+6
recordBuf!3 = recordBuf+106B
recordBuf!4 = recordBuf+106B+20*3
@#645 = recordBuf
]
[CLoop
let command=ReadToken()
if command eq 2 then loop
if command eq 1 then break
let zz=vec 1024*6+800
z=InitializeZone(zz, 1024*6+800)
// Remainder (simple) commands:
switchon command into
[
case 4:
[ //Erase
let locateDDatBeginning = Switch($B)
let n=0
test ReadToken() eq 3 then n=ReadNumber(str) or BackToken()
unless ConfirmWipe(defaultDrive) endcase
unless TFSNewDisk(z, defaultDrive, n*45, (locateDDatBeginning? 1, 0))
then Ws("Cannot build a new disk structure on the drive*n")
endcase
]
case 5:
[ //Copy
let deststr=vec 20
let srcstr=vec 20
let destdisk=ReadFile(deststr)
let consecutive=Switch($C)
ReadToken()
if str>>STRING.char↑1 ne $← then Error("COPY: Missing ← in command.")
let srcdisk=ReadFile(srcstr)
if srcdisk eq 0 then Error("COPY: Not enough parameters.")
let is=OpenFile(srcstr,ksTypeReadOnly,1,0,0,0,z,0,srcdisk)
if is eq 0 then Error("COPY: Input file not found: ", srcstr)
if consecutive ne 0 then
[
let lnPg=destdisk>>DSK.lnPageSize+1 // Log BYTES per page
let fl=vec 1
FileLength(is, fl) // Length in BYTES
let fillout=vec 1
fillout!0=0; fillout!1=-1 rshift (16-lnPg)
DoubleAdd(fl, fillout) // Round up
let siz=(fl!0 lshift (16-lnPg))+(fl!1 rshift lnPg)
let v=DiskFindHole(destdisk, siz+2)
if v eq -1 then Error("COPY: No contiguous hole big enough!")
ReleaseDiskPage(destdisk, AssignDiskPage(destdisk, v-1))
]
let os=OpenFile(deststr, ksTypeWriteOnly, 1, 0, 0, 0, z, 0, destdisk)
if os eq 0 then Error("COPY: Trouble opening file: ", deststr)
if consecutive then
[
ReadLeaderPage(os, scratchVec)
scratchVec>>LD.consecutive=true
WriteLeaderPage(os, scratchVec)
]
Resets(is)
CopyStuff(os, is)
Closes(is)
Closes(os)
endcase
]
case 6:
[ //Delete
let delstr=vec 20
until ReadToken() le 2 do
[
BackToken()
let deldisk=ReadFile(delstr)
let res=DeleteFile(delstr, 0, 0, z, 0, deldisk)
unless res then PutTemplate(dsp,
"DELETE: File not found: $S*n", delstr)
]
endcase
]
case 7:
[ //CreateFile
let creatstr=vec 20
let creatDisk=ReadFile(creatstr)
if creatDisk eq 0 then Error("CREATEFILE: Not enough parameters.")
if ReadToken() ne 3 then Error("CREATEFILE: Not enough parameters.")
let n=ReadNumber(str) //number of pages
DeleteFile(creatstr, 0,0,z,0,creatDisk)
let v=DiskFindHole(creatDisk, n+2)
test v eq -1
ifso Ws("*nCREATEFILE: No contiguous hole big enough, creating non-contiguous file.")
ifnot ReleaseDiskPage(creatDisk, AssignDiskPage(creatDisk, v-1))
let os=OpenFile(creatstr, ksTypeReadWrite, 1, 0, 0, 0, z, 0, creatDisk)
ReadLeaderPage(os, scratchVec)
scratchVec>>LD.consecutive = v ne -1
WriteLeaderPage(os, scratchVec)
if (n+1) ls 0 then // bug in DiskStreams
PositionPage(os, 32767)
PositionPage(os, n+1)
Closes(os)
endcase
]
case 8:
[ //Directory
let verbose=Switch($V)
let outfile=vec 20
let outdisk=ReadFile(outfile)
let outstream=nil
test outdisk
ifso outstream = OpenFile(outfile, ksTypeWriteOnly, 1, 0, 0, 0, z, 0, outdisk)
ifnot [ outstream = dsp; BigDisplay() ]
let compareFn(goodies,nam,dv) = valof
[
// Wait for disk to stop, then force display back on.
// Otherwise directory listing may pause at end of page with
// the display off!
until KBLK>>KBLK.ptr eq 0 do Idle()
if TFSSavedDisplay ne -1 then
[ @DAstart = TFSSavedDisplay; TFSSavedDisplay = -1 ]
let s=goodies!0
PutTemplate(s, "*n$S ", nam)
if goodies!1 then
[
let fs=CreateDiskStream(lv dv>>DV.fp, ksTypeReadOnly, 1, 0, 0, z, 0, goodies!3)
test fs eq 0
ifso Wss(s," -- cannot open file.")
ifnot
[
let fl=vec 1
FileLength(fs, fl)
PutTemplate(s, ", length = $ED. bytes. ", fl)
ReadLeaderPage(fs, scratchVec)
if scratchVec>>LD.consecutive then Wss(s, "contiguous")
let pages=1+(fl!0 lshift 5)+(fl!1 rshift 11)+1
PutTemplate(s, " ($UD. pages)", pages)
Closes(fs)
]
]
resultis true
]
let defaultDisk=InitDisk(defaultDrive)
let s=OpenFile("SysDir",ksTypeReadOnly,0,0,0,0,z,0,defaultDisk)
let goodies=vec 4
goodies!0=outstream
goodies!1=verbose
goodies!3=defaultDisk
goodies!4 = outdisk
Zero(MyFrame()-300, 300) // Gets around OS 17 bug (don't ask!!)
FindFdEntry(s, goodies, compareFn)
Closes(s)
let h=defaultDisk>>DSK.diskKd
let dp=vec 1
dp!0=0
dp!1=h>>TFSKD.freePages
PutTemplate(outstream,
"*nThere are $UD. free pages.", h>>TFSKD.freePages)
PutTemplate(outstream,
"*nTransfers: $ED, Errors: $ED, ECC errors: $ED, ECC fixes: $ED",
lv h>>TFSKD.nTransfers, lv h>>TFSKD.nErrors,
lv h>>TFSKD.nECCErrors, lv h>>TFSKD.nECCFixes)
PutTemplate(outstream,
"*nRestores: $ED, Unrecoverable: $ED, BT discrepancies: $ED",
lv h>>TFSKD.nRestores, lv h>>TFSKD.nUnRecov, lv h>>TFSKD.nBTErrors)
test outstream eq dsp ifso SmallDisplay() ifnot Closes(outstream)
endcase
]
case 9:
[ //Print disk addresses
let nam=vec 20
let disk=ReadFile(nam)
if disk eq 0 then Error("ADDRESSES: No file name.")
let s=OpenFile(nam,ksTypeReadOnly,0,0,0,0,z,0,disk)
if s eq 0 then Error("ADDRESSES: File not found: ",nam)
let firstDa=-1
let firstPn=1
BigDisplay()
[ // repeat
let c=vec lCFA
GetCompleteFa(s, c)
let l=ReadBlock(s, scratchVec, 1024)
let np=c>>CFA.fa.pageNumber-firstPn
if l ne 1024 % np+firstDa ne c>>CFA.fa.da then
[
if np+firstDa eq c>>CFA.fa.da then np = np+1
if firstDa ne -1 then
PutTemplate(dsp, "*n Pages $UD to $UD have DAs $UD to $UD",
firstPn, firstPn+np-1, firstDa, firstDa+np-1)
firstDa=c>>CFA.fa.da
firstPn=c>>CFA.fa.pageNumber
]
if l ne 1024 then break
] repeat
Closes(s)
SmallDisplay()
endcase
]
case 10:
[ //certify a pack
let passes = 10
test ReadToken() eq 3
ifso passes = ReadNumber(str)
ifnot BackToken()
CertifyPack(defaultDrive, passes)
endcase
]
case 11:
[ // set default Drive
defaultDrive = ReadToken() eq 3? ReadNumber(str, 8), ReadDrive(str)
if defaultDrive ls 0 then
Error("Illegal argument to DRIVE command.")
endcase
]
case 12:
[ //Exercise
let nPasses=10
let driveVec = vec nDrives; SetBlock(driveVec, true, nDrives)
if ReadToken() eq 3 then
[
nPasses=ReadNumber(str)
if ReadToken() eq 3 then
[
Zero(driveVec, nDrives)
[
let n = ReadNumber(str)
if n ls nDrives then driveVec!n = true
] repeatwhile ReadToken() eq 3
]
]
BackToken()
Exercise(nPasses, driveVec, checkIt)
endcase
]
case 13:
[ //Convert
TFUConvert(defaultDrive)
endcase
]
case 14:
[ //list known bad spots
ListBadSpots(defaultDrive)
endcase
]
case 15:
[ //reset bad spot table
ResetBadSpots(defaultDrive)
endcase
]
case 16:
[ //rename
let deststr=vec 20
let srcstr=vec 20
let destdisk=ReadFile(deststr)
ReadToken()
if str>>STRING.char↑1 ne $← then
Error("RENAME: Missing ← in command.")
let srcdisk=ReadFile(srcstr)
if srcdisk eq 0 then Error("RENAME: Not enough parameters.")
test srcdisk ne destdisk
ifso Error("RENAME: can't rename across disks.")
ifnot unless RenameFile(srcstr, deststr, 0, 0, z, 0, destdisk) do
Error("RENAME: failed to rename file.")
endcase
]
default:
Error("Unknown command: ", str)
endcase
]
InitDisk() // Close the disks!
if lastToken eq 1 then break
]CLoop repeat
if TFSDebug then ReportDebugStats()
]
//----------------------------------------------------------------------------
and TFUFinish() be
//----------------------------------------------------------------------------
[
@lvIdle = saveIdle
@lvUserFinishProc=savedUFP
InitDisk() //Close the disks
CloseLog()
@lvSwatContextProc = saveSCP
test dMachine
ifnot TFSSilentBoot()
ifso StartIO(#20) //turn off Trident microcode
]
//----------------------------------------------------------------------------
and TFUIdle() be
//----------------------------------------------------------------------------
[
manifest [ cursorX = #426; cursorY = #427 ]
@cursorX = 20 + KBLK>>KBLK.drive lshift 6
@cursorY = KBLK>>KBLK.track
]
//----------------------------------------------------------------------------
and CopyStuff(os, is) be
//----------------------------------------------------------------------------
[
let buf=@#335
let siz=(MyFrame()-3000-buf)
@#335=buf+siz
let l=nil
[
l=ReadBlock(is, buf, siz)
WriteBlock(os, buf, l)
] repeatuntil l ne siz
@#335=buf
]
// Disk selection stuff.
// InitDisk() -- close all inited drives
// InitDisk(n) -- init drive n and return "disk" structure
//----------------------------------------------------------------------------
and InitDisk(drive; numargs n) =valof
//----------------------------------------------------------------------------
[
if n eq 0 then
[
for i=0 to nDisks-1 do if mpDriveDisk!i ne 0 then
[ TFSClose(mpDriveDisk!i); mpDriveDisk!i=0 ]
resultis 0
]
let iDisk = nDrives*(drive rshift 8) + driveŹ
if mpDriveDisk!iDisk ne 0 then resultis mpDriveDisk!iDisk
let tridentDisk=TFSInit(z, true, drive)
if tridentDisk eq 0 then
[
PutTemplate(dsp, "*nCannot operate Trident drive $O. Check it out!", drive)
finish;
]
mpDriveDisk!iDisk=tridentDisk
resultis tridentDisk
]
//----------------------------------------------------------------------------
and IsTrident(disk) = valof
//----------------------------------------------------------------------------
[
if disk eq 0 then resultis false
for i=0 to nDisks-1 do if disk eq mpDriveDisk!i then
resultis true
resultis false
]
//----------------------------------------------------------------------------
and ConfirmWipe(drive) = valof
//----------------------------------------------------------------------------
[
PutTemplate(dsp, "Confirm wiping the pack on drive $O:*nType OK to proceed, A to abort: ", drive)
if noConfirm then [ Ws("OK*n"); resultis true ]
[ // repeat
let c=Gets(keys)
if c eq $A % c eq $a then resultis false
unless c eq $O % c eq $o then loop
Ws("O")
c=Gets(keys)
unless c eq $K % c eq $k then loop
Ws("K*n")
resultis true
] repeat
]