// -- TDP.bcpl
// Diagnostic Program for Dual Density Alto Magnetic Tapes
// Last modified by Tim Diebert, March 16, 1981 5:21 PM
// Copyright Xerox, 1981

get "DDTapes.d"
get "MenuDefs.d"
get "AltoDefs.D"
get "TDPDefs.d" // This defs file contains the interesting stuff for TDP.

get "TDPMenuNames.d"

// These are defined as External in TDPDefs.d
static
[
// statics used by or supplied to TDPUtil
BitMsg
DataCompareFlag
DispAfterErrorFlag
driveno
dumpstream
LogFile
LogFlag
LoopReadAfterWriteFlag
menu
mode
NumBadData
NumLowThreshold
NumOperationsThisPass
NumPersistant
NumReel
NumReGaps
NumRetries
NumRetriesgt1
OpDensity
readbuf
readbufword // word lengths, plus extra room
readl // byte lengths
retry
SCompareReadFlag
SingleReadAfterWriteFlag
StopAEflag
StopDEflag
TapeTridentUFP
vtape
writebufword // word lengths, plus extra room
writebuf
writel // byte lengths

]

manifest
[
muchcore=#76000
// mode names
octal = 0
ascii = 1
ebcdic = 2
bytemode = 3
// ASCII stuff
CR = #15
]

structure BT:
[
char↑0,0 byte
]


let Main() be
[
PutTemplate(dsp,"*NTDP of March 16, 1981 5:21 PM --- Tape Diagnostic Program")

// Init the trident/tape microcode, set up code to return tasks to ROM when done.
InitializeDDTape()
InitBcplRuntime()
SetEndCode(InitializeDDTape)

// Start by moving freecore into the "heap"
let v=GetFixed(muchcore)
unless v do CallSwat("GetFixed failed")
AddToZone(sysZone,v,muchcore)
let fh= sysFont!(-2)
let nLines=32
let wWidth=38
let lBlock=lDCB*nLines+fh*wWidth*nLines+1
dumpstream=CreateDisplayStream(nLines,Allocate(sysZone,lBlock),lBlock)

// Set up menu

let length = MenuSize() + 1 // Paranoia from an old bug
let buffer = Allocate(sysZone,length)
let menustream = CreateMenuDisplayStream(buffer,length)
menu=MenuData>>DATA.menu
ShowDisplayStream(menustream,DSbelow)
ShowDisplayStream(dumpstream,DSbelow,menustream)

// Set up program defaults and display it in the boxes on the menu

mode = bytemode
WriteBox(menu!Mode,"Byte")

let readlstr = SysStr("1024")
readl = 1024
WriteBox(menu!ReadL,readlstr)
readbufword = readl rshift 1 +1
readbuf = Allocate(sysZone, readbufword)

let writelstr = SysStr("1024")
writel = 1024
WriteBox(menu!WriteL,writelstr)
writebufword = writel rshift 1 + 1
writebuf = Allocate(sysZone, writebufword)
for i = 0 to writel-1 do writebuf>>BT.char↑i = ( i & #377 )

LogFlag = false
LogFile = 0
WriteBox(menu!tLog, "Error Logging OFF")

let drivestr = SysStr("0")
driveno = 0
WriteBox(menu!Unit,drivestr)

let retrystr = SysStr("0")
retry = 0
WriteBox(menu!Retries,retrystr)

let OpDensitystr = "PE"
OpDensity = PE
WriteBox(menu!tSingleDensitySet, OpDensitystr)

SingleReadAfterWriteFlag = false
WriteBox(menu!tSingleReadAfterWrite, "Read after Write OFF")

SCompareReadFlag = false
WriteBox(menu!tSingleCompareAfterRead, "Comp after Read OFF")

StopDEflag = false
WriteBox(menu!tStopDE, "Stop on Data Error OFF")

StopAEflag = false
WriteBox(menu!tStopAE, "Stop on Any Error OFF")

LoopReadAfterWriteFlag = false
WriteBox(menu!tLoopReadAfterWrite, "Read after Write OFF")

DataCompareFlag = true
WriteBox(menu!tDataCompare, "Data Compare ON")

DispAfterErrorFlag = true
WriteBox(menu!tDispAfterError, "Disp Status on Error ON")

// open the initial tape
ReOpenTape()

// Loop over menu routine
WriteBox(menu!Title, "TDP of February 10, 1981 2:08 PM --- Tape Diagnostic Program")
FillBox(menu!Title,0)
NumOperationsThisPass = 0
NumRetries = 0
NumRetriesgt1 = 0
NumReGaps = 0
NumLowThreshold = 0
NumPersistant = 0
NumBadData = 0
NumReel = 0

[
let selection = ScanMenu(menu)
switchon selection into
[

case tMode:
[
mode = (mode + 1) rem 4
let modetext = selecton mode into
[
case octal : "Octal"
case ascii : "Ascii"
case ebcdic : "Ebcdic"
case bytemode : "Byte"
]
FillBox(menu!Mode, white)
WriteBox(menu!Mode, modetext)
]
endcase

case tShowRead:
[
Dump("*n**Read Buffer**",readbuf,vtape>>VDDTCB.ByteCount)
endcase
]

case tReadL:
[
Free(sysZone,readbuf)
[
readlstr = GetString(menu!ReadL, readlstr, sysZone)
readl = StrToInt(readlstr)
readbufword = readl rshift 1 + 1
readbuf=Allocate(sysZone,readbufword, true)
unless readbuf do
Ws("*nRead buffer too large")
] repeatuntil readbuf
]
endcase

case tShowWrite:
[
Dump("*n**Write Buffer**",writebuf,writel)
endcase
]

case tWriteL:
[
Free(sysZone,writebuf)
[
writelstr = GetString(menu!WriteL, writelstr, sysZone)
writel = StrToInt(writelstr)
writebufword = writel rshift 1 + 1
writebuf=Allocate(sysZone,writebufword, true)
unless writebuf do
Ws("*nWrite buffer too large")
] repeatuntil writebuf
for i = 0 to writel-1 do writebuf>>BT.char↑i = ( i & #377 )
]
endcase

case tPattern:
[
PatternRoutine()
endcase
]

case tCompareBuffers:
[
CompareRoutine()
endcase
]

case tLog:
[
test LogFlag
ifso
[
FillBox(menu!tLog, white)
WriteBox(menu!tLog, "Error Logging OFF")
FillBox(menu!tLog, flip)
LogFlag = false
if LogFile ne 0 do
[
TruncateDiskStream(LogFile)
Closes(LogFile)
LogFile = 0
]
]
ifnot
[
FillBox(menu!tLog, white)
WriteBox(menu!tLog, "Error Logging ON")
FillBox(menu!tLog, flip)
if LogFile ne 0 then CallSwat("File messed up")
LogFile = OpenFile("TDP.Log")
unless LogFile then CallSwat("Error in file open")
LogFlag = true
]
]
endcase

case QuitIt:
[
CloseDDTape(vtape)
if LogFlag then
[
TruncateDiskStream(LogFile)
Closes(LogFile)
]
finish
]
endcase

// Single Operation Stuff

case tUnit:
[
[
drivestr = GetString(menu!Unit, drivestr, sysZone)
driveno = StrToInt(drivestr)
if outside(0, driveno, 3) do
Ws("*nDrive Number must be 0..3")
] repeatwhile outside(0, driveno, 3)
ReOpenTape()
]
endcase

case tRetries:
[
retrystr = GetString(menu!Retries, retrystr, sysZone)
retry = StrToInt(retrystr)
if outside(0, retry, 8) do
Ws("*nRetry count must be 0...8")
] repeatwhile outside(0, retry, 8)
endcase

case tSingleDensitySet:
[
test OpDensity eq PE
ifso
[
OpDensity = NRZI
OpDensitystr = "NRZI"
FillBox(menu!tSingleDensitySet, white)
WriteBox(menu!tSingleDensitySet, OpDensitystr)
FillBox(menu!tSingleDensitySet, flip)
SetDensity(vtape, OpDensity)
]
ifnot
[
OpDensity = PE
OpDensitystr = "PE"
FillBox(menu!tSingleDensitySet, white)
WriteBox(menu!tSingleDensitySet, OpDensitystr)
FillBox(menu!tSingleDensitySet, flip)
SetDensity(vtape, OpDensity)
]
]
endcase

case tSingleReadAfterWrite:
[
test SingleReadAfterWriteFlag
ifso
[
SingleReadAfterWriteFlag = false
FillBox(menu!tSingleReadAfterWrite, white)
WriteBox(menu!tSingleReadAfterWrite, "Read after Write OFF")
FillBox(menu!tSingleReadAfterWrite, flip)
]
ifnot
[
SingleReadAfterWriteFlag = true
FillBox(menu!tSingleReadAfterWrite, white)
WriteBox(menu!tSingleReadAfterWrite, "Read after Write ON")
FillBox(menu!tSingleReadAfterWrite, flip)
]
]
endcase

case tSingleCompareAfterRead:
[
test SCompareReadFlag
ifso
[
SCompareReadFlag = false
FillBox(menu!tSingleCompareAfterRead, white)
WriteBox(menu!tSingleCompareAfterRead, "Comp after Read OFF")
FillBox(menu!tSingleCompareAfterRead, flip)
]
ifnot
[
SCompareReadFlag = true
FillBox(menu!tSingleCompareAfterRead, white)
WriteBox(menu!tSingleCompareAfterRead, "Comp after Read ON")
FillBox(menu!tSingleCompareAfterRead, flip)
]
]
endcase


case tReadFwd:
[
if SCompareReadFlag do SetBlock(readbuf, #125252, readbufword)
ActOnDDTape(vtape, ReadFwd, readbuf, readbufword, 0, 0, retry)
DispDDStatus()
if SCompareReadFlag do CompareData()
]
endcase

case tWriteFwd:
[
if SCompareReadFlag & SingleReadAfterWriteFlag do SetBlock(readbuf, #125252, readbufword)
ActOnDDTape(vtape, Write, readbuf, readbufword, writebuf, writel, retry, SingleReadAfterWriteFlag)
DispDDStatus()
if SCompareReadFlag & SingleReadAfterWriteFlag do CompareData()
]
endcase

case tFwdSkip:
[
ActOnDDTape(vtape, FwdSpaceRecord)
DispDDStatus()
]
endcase

case tWriteEOF:
[
ActOnDDTape(vtape, WriteEOF, 0, 0, 0, 0, retry)
DispDDStatus()
]
endcase

case tFwdBk:
[
ActOnDDTape(vtape, FwdSpaceFile)
DispDDStatus()
]
endcase

case tErase:
[
ActOnDDTape(vtape, Erase)
DispDDStatus()
endcase
]

case tReadRev:
[
ActOnDDTape(vtape, ReadRev, readbuf, readbufword, 0, 0, retry)
DispDDStatus()
]
endcase

case tRewind:
[
ActOnDDTape(vtape, Rewind)
DispDDStatus()
]
endcase

case tBackSkip:
[
ActOnDDTape(vtape, BackSpaceRecord)
DispDDStatus()
]
endcase

case tUnload:
[
ActOnDDTape(vtape, Unload)
DispDDStatus()
]
endcase

case tBackBk:
[
ActOnDDTape(vtape, BackSpaceFile)
DispDDStatus()
]
endcase

case tNoOp:
[
ActOnDDTape(vtape, NoOp)
DispDDStatus()
]
endcase

case tResetOp:
[
PerformVDDTCB(vtape, Reset)
DispDDStatus()
]
endcase

// Loop Operation Stuff

case tDispStat:
[
DisplayCounts()
endcase
]

case tReset:
[
NumOperationsThisPass = 0
NumRetries = 0
NumRetriesgt1 = 0
NumReGaps = 0
NumPersistant = 0
NumBadData = 0
NumReel = 0
DisplayCounts()
]
endcase

case tReadLoop:
[
let flags = nil
let StopFlag = false
let statflag = false
[
[
ActOnDDTape(vtape,ReadFwd,readbuf,readbufword,0,0,retry)
flags = vtape>>DDTCB.Flags
if (flags eq 0) % ((flags & #100000) eq 0) % ((flags & #7) ne 0) do StopFlag = true
NumOperationsThisPass = NumOperationsThisPass + 1
unless (flags & #1235) ne 0 do // FMK % HE % DL % RDP % HDWERR % CMDER
[
if DataCompareFlag do
[
unless CompareData() then
[
StopFlag = StopDEflag % StopAEflag
NumBadData = NumBadData + 1
]
]
]

if (flags & TapeErr) ne 0 then
[
if StopAEflag then StopFlag = true
NumPersistant = NumPersistant + 1
if DispAfterErrorFlag then DispDDStatus()
statflag = true
]

if (retry ne 0) & vtape>>VDDTCB.lowthresh then NumLowThreshold = NumLowThreshold + 1

if (retry ne 0) & (vtape>>VDDTCB.retries ne retry) then
[
NumRetries = NumRetries + 1
if (retry - vtape>>VDDTCB.retries) ne 1 then NumRetriesgt1 = NumRetriesgt1 + 1
]
statflag = false
] repeatuntil Blue() % flags<<DDStatus.EOT % flags<<DDStatus.FMK % StopFlag
DisplayCounts()
if (flags<<DDStatus.EOT % flags<<DDStatus.FMK) & (not StopFlag) then
[
TapeRewindWait(vtape)
NumReel = NumReel + 1
NumOperationsThisPass = 0
]
] repeatuntil Blue() % StopFlag
]

endcase

case tWriteLoop:
[
let flags = nil
let StopFlag = false
let statflag = false
[
[
ActOnDDTape(vtape, Write, readbuf, readbufword, writebuf, writel, retry, LoopReadAfterWriteFlag)
flags = vtape>>DDTCB.Flags
if (flags eq 0) % ((flags & #100000) eq 0) % ((flags & #7) ne 0) do StopFlag = true
NumOperationsThisPass = NumOperationsThisPass + 1
unless (flags & TapeErr) ne 0 do
[
if DataCompareFlag do
[
unless CompareData() then
[
StopFlag = StopDEflag % StopAEflag
NumBadData = NumBadData + 1
]
]
]

if (flags & TapeErr) ne 0 then
[
if StopAEflag then StopFlag = true
NumPersistant = NumPersistant + 1
if DispAfterErrorFlag do DispDDStatus()
statflag = true
]

if (retry ne 0) & (vtape>>VDDTCB.regap le 0) then
[
NumReGaps = NumReGaps + 1
if vtape>>VDDTCB.retries eq retry then NumRetries = NumRetries + 1
]

if (retry ne 0) & (vtape>>VDDTCB.retries ne retry) then
[
NumRetries = NumRetries + 1
if (retry - vtape>>VDDTCB.retries) ne 1 then NumRetriesgt1 = NumRetriesgt1 + 1
]
statflag = false

] repeatuntil Blue() % flags<<DDStatus.EOT % StopFlag
DisplayCounts()
if flags<<DDStatus.EOT & (not StopFlag) then
[
TapeRewindWait(vtape)
NumReel = NumReel + 1
NumOperationsThisPass = 0
]
] repeatuntil Blue() % StopFlag
]
endcase

case tStopDE:
[
test StopDEflag
ifso
[
FillBox(menu!tStopDE, 3)
WriteBox(menu!tStopDE, "Stop on Data Error OFF")
FillBox(menu!tStopDE, 0)
StopDEflag = false
]
ifnot
[
FillBox(menu!tStopDE, 3)
WriteBox(menu!tStopDE, "Stop on Data Error ON")
FillBox(menu!tStopDE, 0)
StopDEflag = true
]
]
endcase

case tStopAE:
[
test StopAEflag
ifso
[
FillBox(menu!tStopAE, 3)
WriteBox(menu!tStopAE, "Stop on Any Error OFF")
FillBox(menu!tStopAE, 0)
StopAEflag = false
]
ifnot
[
FillBox(menu!tStopAE, 3)
WriteBox(menu!tStopAE, "Stop on Any Error ON")
FillBox(menu!tStopAE, 0)
StopAEflag = true
]
]
endcase

case tLoopReadAfterWrite:
[
test LoopReadAfterWriteFlag
ifso
[
LoopReadAfterWriteFlag = false
FillBox(menu!tLoopReadAfterWrite, white)
WriteBox(menu!tLoopReadAfterWrite, "Read after Write OFF")
FillBox(menu!tLoopReadAfterWrite, flip)
]
ifnot
[
LoopReadAfterWriteFlag = true
FillBox(menu!tLoopReadAfterWrite, white)
WriteBox(menu!tLoopReadAfterWrite, "Read after Write ON")
FillBox(menu!tLoopReadAfterWrite, flip)
]
]
endcase

case tDataCompare:
[
test DataCompareFlag
ifso
[
FillBox(menu!tDataCompare, white)
WriteBox(menu!tDataCompare, "Data Compare OFF")
FillBox(menu!tDataCompare, flip)
DataCompareFlag = false
]
ifnot
[
FillBox(menu!tDataCompare, white)
WriteBox(menu!tDataCompare, "Data Compare ON")
FillBox(menu!tDataCompare, flip)
DataCompareFlag = true
]
]
endcase

case tDispAfterError:
[
test DispAfterErrorFlag
ifso
[
FillBox(menu!tDispAfterError, white)
WriteBox(menu!tDispAfterError, "Disp Status on Error OFF")
FillBox(menu!tDispAfterError, flip)
DispAfterErrorFlag = false
]
ifnot
[
FillBox(menu!tDispAfterError, white)
WriteBox(menu!tDispAfterError, "Disp Status on Error ON")
FillBox(menu!tDispAfterError, flip)
DispAfterErrorFlag = true
]
]
endcase


]
DeSelect(menu!selection)
] repeat
]


and ReOpenTape() be
[
if vtape do CloseDDTape(vtape) // will not be here first time
vtape = OpenDDTape(driveno, TapeErrProc, TapeErrProc)
let flags = PerformVDDTCB(vtape, NoOp)
test flags eq 0
ifso
[
let errproc = vtape>>VDDTCB.errProc
errproc("*N Tape Drive did not respond to a NoOp")
]
ifnot
[
unless flags<<DDStatus.BOT do TapeRewindWait(vtape)
]
SetDensity(vtape, OpDensity)
]

and TapeWaitQuiet() be Idle()

and Block() be Idle()

and outside(low, arg, hi) = (arg ls low) % (arg gr hi)