//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&#377

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
]