// Certify.bcpl -- BFS Certify program
// Copyright Xerox Corporation 1986
// created November 23, 1986  7:18 PM by Putz
// Last modified November 24, 1986  5:59 AM by Putz

// To compile and load:
//		BCPL/O Certify.bcpl
//		Bldr/LV Certify BFSInit GP Template Random

get "Altofilesys.d"
get "AltoDefs.d"
get "Streams.d"
get "SysDefs.d"
get "Disks.d"
get "Bfs.d"

external
[
	// incoming procedures
	BFSInit				// from BFSInit.br
	PutTemplate		// from Template.br
	Random				// from Random.br
	ReadParam		// from GP.br
	SetupReadParam

	// from OS
	VirtualDiskDA; CloseDisk; BfsMakeFpFromLabel
	InitializeDiskCBZ; GetDiskCb; DoDiskCommand
	Ws; dsp; keys; Endofs; Gets; Resets
	OpenFile; Closes; CleanupDiskStream
	Zero; MoveBlock; SetBlock; Noop; lvIdle; Idle
	Allocate; Free; DefaultArgs; MyFrame; GotoLabel
	sysZone; lvUserFinishProc; lvSysErr
]

static
[
	label; data; machineType
	maxVDA; certDisk; eTable
	nDisks; nTracks; nSectors
	origPartition; savedUFP; savedIdle
	certPartition; currentPass; logFile
	abortFlag = false
	doPrompt = true
	nPasses = 100		// default
]

manifest
[
	maxETEntries = 200
	errorThreshold = 1
	abortChar = 3		// abort with control-C
]

structure String [ length byte; char^1,1 byte ]

structure ET:  //Error Table
[
	nEntries word
	entry^0,maxETEntries-1 [ da word; nErrors word ]
]
manifest lenET = size ET/16

//----------------------------------------------------------------------------
let Certify() be
//----------------------------------------------------------------------------
[	Ws("Certify.run of November 24, 1986.")
	// show "BFS" cursor
	MoveBlock(cursorBitMap,
		table [ 0; 0; 0; 0; 161706b; 111011b; 111010b; 161606b;
				111001b; 111011b; 161006b; 0; 0; 0; 0; 0 ], 16)
	machineType = AltoVersion()
	if machineType ls 4 then
	[	Ws("No partitions on this machine.")
		abort
	]
	origPartition = ChangePartition(0)
	savedIdle = @lvIdle
	savedUFP = @lvUserFinishProc
	@lvSysErr = MyErr
	@lvUserFinishProc = MyCleanUp

	// Allocate buffers
	//	let spaceLeft = nil
	//	Allocate(sysZone, 30000, lv spaceLeft)
	//	PutTemplate(dsp, "*NSpace left = $D", spaceLeft)
	eTable = Allocate(sysZone, lenET)
	data = Allocate(sysZone, 256)
	label = Allocate(sysZone, 8)

	logFile = OpenFile("Certify.log", ksTypeWriteOnly, charItem)
	//get partition number and number of passes from command line
	let switches = vec 50		// unpacked string
	SetupReadParam(0, switches)
 	doPrompt = not ((switches!0 ge 1)
		& ((switches!1 eq $y) % (switches!1 eq $Y)))
	let noArgs = true
	[	certPartition = ReadParam($D, -1)
		while (switches!0 eq 1) & ((switches!1 & 0337) eq $P) do
		[	// switch /P sets number of passes
			nPasses = certPartition
			certPartition = ReadParam($D, -1)
		]
		if certPartition eq -1 break
		CertifyPartition()
		noArgs = false
	] repeatuntil abortFlag
	if noArgs then Ws("*NUsage:  Certify[/Yes] [nPasses/P] partNum ... partNum")
	Free(sysZone, eTable)
	Free(sysZone, data)
	Free(sysZone, label)
]

and let CertifyPartition() be
[	ChangePartition(certPartition)
	if ChangePartition(0) ne certPartition then abort

	Zero(eTable, lenET)
	unless GetDiskShape() abort
	let format = "*NCertify BFS$D Disks: $D, Cylinders: $D, Heads: 2, Sectors: $D"
	PutTemplate(dsp, format, certPartition, nDisks, nTracks, nSectors)
	if doPrompt then
	[	PutTemplate(dsp, "*NConfirm erase and certify BFS$D ($D passes)", certPartition, nPasses)
		if not Confirm("? ") then finish
		let now = @realTimeClock
		while now + 5*27 ugr @realTimeClock loop
		Resets(keys)
		if not Confirm("*NAre you still sure? ") then finish
	]
	ChangePartition(origPartition)
	PutTemplate(logFile, format, certPartition, nDisks, nTracks, nSectors)
	ChangePartition(certPartition)
	certDisk = BFSInit(sysZone, false, 0, 0, true)
	certDisk>>BFSDSK.nDisks = nDisks
	certDisk>>BFSDSK.nTracks = nTracks
	certDisk>>BFSDSK.nSectors = nSectors
	maxVDA = nDisks * nTracks * 2 * nSectors -1
	@lvIdle = MyIdle

	// Set up read and write cursors
	let rCursor = table [
		0; 0; 0; 76000b; 41000b; 41000b; 41000b; 76000b
		44000b; 42000b; 42000b; 41000b; 41000b; 0; 0; 0 ]
	let wCursor = table [
		0; 0; 0; 40400b; 44400b; 44400b; 44400b; 25000b
		25000b; 25000b; 12000b; 12000b; 12000b; 0; 0; 0 ]
	let savedCursor = vec 16
	MoveBlock(savedCursor, cursorBitMap, 16)

	// suck out a random number of random numbers
	let c = @realTimeClock & 7777b
	while c ne 0 do [ Random(); c = c-1 ]

	// certify the disk
	for i = 1 to nPasses do
	[	currentPass = i
		for w = 0 to 255 do data!w = Random()
		MoveBlock(cursorBitMap, wCursor, 16)
		certDisk>>DSK.retryCount = 8
		if SweepDisk(i eq 1? DCwriteHLD, DCwriteLD) break
		MoveBlock(cursorBitMap, rCursor, 16)
		certDisk>>DSK.retryCount = 1
		if SweepDisk(DCreadLD) break
	]

	// mark bad spots incorrigable
	certDisk>>DSK.retryCount = 8
	SetBlock(lv label>>DL.fileId, -2, lFID)
	for i = 0 to eTable>>ET.nEntries-1 do
		if eTable>>ET.entry^i.nErrors uge errorThreshold then
		[	let da = eTable>>ET.entry^i.da
			let vda = VirtualDiskDA(certDisk, lv da)
			XferPage(DCwriteHLD, vda, 0, label, 0, lv Noop)
			let format = "*N        BFS$D Un $D, Cyl $3F0D, Hd $D, Sec $2F0D.  Errors = $D"
			PutTemplate(dsp, format, certPartition, da<<DA.disk,
				da<<DA.track, da<<DA.head, da<<DA.sector,
				eTable>>ET.entry^i.nErrors)
		   ChangePartition(origPartition)
			PutTemplate(logFile, format, certPartition, da<<DA.disk,
				da<<DA.track, da<<DA.head, da<<DA.sector,
				eTable>>ET.entry^i.nErrors)
		   ChangePartition(certPartition)
		]
	PutTemplate(dsp,
		"*N$D pages marked bad on BFS$D in $D passes.",
		eTable>>ET.nEntries, certPartition, currentPass)

	MoveBlock(cursorBitMap, savedCursor, 16)
	CloseDisk(certDisk)
	ChangePartition(origPartition)
	PutTemplate(logFile,
		"*N$D pages marked bad on BFS$D in $D passes.*N",
		eTable>>ET.nEntries, certPartition, currentPass)
	CleanupDiskStream(logFile)
]

//----------------------------------------------------------------------------
and GetDiskShape(action) = valof
//----------------------------------------------------------------------------
[
	if TryDisk(0, 0, 0, 0)<<DST.notReady then
	   [ Ws(".  DP0 is not ready!"); resultis false ]
	nDisks, nTracks, nSectors = 1, 203, 12
	unless TryDisk(1, 0, 0, 0)<<DST.notReady do
	   nDisks = 2
	unless TryDisk(0, 203, 0, 0)<<DST.seekFail do
	   nTracks = 406
	unless TryDisk(0, 0, 0, 13)<<DST.finalStatus eq badSector do
	   nSectors = 14
	resultis true
]

//----------------------------------------------------------------------------
and TryDisk(dsk, trk, hd, sect) = valof
//----------------------------------------------------------------------------
[
	let kcb = vec lKCB; Zero(kcb, lKCB)
	kcb>>KCB.command = seekOnly
	kcb>>KCB.headerAddress = lv kcb>>KCB.header
	kcb>>KCB.labelAddress = label
	kcb>>KCB.dataAddress = data
	kcb>>KCB.diskAddress.disk = dsk
	kcb>>KCB.diskAddress.track = trk
	kcb>>KCB.diskAddress.head = hd
	kcb>>KCB.diskAddress.sector = sect
	@diskAddress = -1
	until @diskCommand eq 0 loop
	for trys = 1 to 5 do
	[
		kcb>>KCB.status = 0
		@diskCommand = kcb
		while (kcb>>KCB.status & DSTdoneBits) eq 0 loop
		if (kcb>>KCB.status & DSTgoodStatusMask) eq DSTgoodStatus break
	]
	resultis kcb>>KCB.status
]

//----------------------------------------------------------------------------
and SweepDisk(action) = valof
//----------------------------------------------------------------------------
[
	let zoneLength = certDisk>>DSK.lengthCBZ + 2*nSectors*certDisk>>DSK.lengthCB
	let cbz = Allocate(sysZone, zoneLength)
	InitializeDiskCBZ(certDisk, cbz, 0, zoneLength, SweepRetry, lv SweepError)
	cbz>>CBZ.cleanupRoutine = Noop
	cbz>>CBZ.errorDA = 0
	cbz>>CBZ.client = MyFrame()

	SweepRetry: let sweepVDA = cbz>>CBZ.errorDA
	while sweepVDA le maxVDA do
	   [
	   let cb = GetDiskCb(certDisk, cbz)
	   cb>>CB.labelAddress = data
	   DoDiskCommand(certDisk, cb, data, sweepVDA, data+5, data!4, action)
	   sweepVDA = sweepVDA +1
	   if (sweepVDA & 77b) eq 0 then
	      [ if not Endofs(keys) then
			[	PutTemplate(dsp, "*NCurrent Pass = $D", currentPass)
				if Gets(keys) eq abortChar then
				[ abortFlag = true; break ]
			]
			if machineType eq 4 then Idle() ]
	   ]

	while @cbz>>CBZ.queueHead ne 0 do GetDiskCb(certDisk, cbz)
	Free(sysZone, cbz)
	resultis abortFlag
]

//----------------------------------------------------------------------------
and SweepError(nil, cb, nil) be
//----------------------------------------------------------------------------
[
	let dst = cb>>CB.status
	let da = cb>>CB.diskAddress
		if dst<<DST.checksumError ne 0 & dst<<DST.dataLate eq 0 then
	   [
	   PutTemplate(dsp, "*NChecksum error at BFS$D Un $D, Cyl $3F0D, Hd $D, Sec $2F0D.",
			certPartition, da<<DA.disk, da<<DA.track, da<<DA.head,
			da<<DA.sector)
	   let i = 0; while i ls eTable>>ET.nEntries do
	      [ if da eq eTable>>ET.entry^i.da break; i = i +1 ]
	   if i ls maxETEntries then
	      [
	      if eTable>>ET.entry^i.nErrors eq 0 then
	         [
	         eTable>>ET.nEntries = eTable>>ET.nEntries +1
	         eTable>>ET.entry^i.da = da
	         ]
	      eTable>>ET.entry^i.nErrors = eTable>>ET.entry^i.nErrors +1
	      PutTemplate(dsp, "  Errors here = $UD/$D", eTable>>ET.entry^i.nErrors, currentPass)
	      ]
	   if i eq maxETEntries then Ws(" Error table full!")
	   ]

	// treat it sort of like a soft error
	let cbz = cb>>CB.cbz
	cbz>>CBZ.errorDA = VirtualDiskDA(certDisk, lv da) +1
	InitializeDiskCBZ(certDisk, cbz)
	if certDisk>>DSK.retryCount eq 1 & dst<<DST.seekFail then
	   [  //retry count of one bypasses GetCB's recal for pos errors
	   @diskAddress = -1
	   DoDiskCommand(certDisk, GetDiskCb(certDisk, cbz), 0, 0, 0, 0, 525b)
   ]
	GotoLabel(cbz>>CBZ.client, cbz>>CBZ.retry)
]

//----------------------------------------------------------------------------
and XferPage(action, vda, d, l, h, lvError; numargs na) = valof
//----------------------------------------------------------------------------
[
let header = vec 1
DefaultArgs(lv na, -2, data, label, header, lv XferError)
let cbz = vec CBzoneLength
InitializeDiskCBZ(certDisk, cbz, 0, CBzoneLength, XferRetry, lvError)
cbz>>CBZ.cleanupRoutine = XferCleanup
cbz>>CBZ.client = h
XferRetry: let cb = GetDiskCb(certDisk, cbz)
cb>>CB.labelAddress = l
let fp = vec lFP; BfsMakeFpFromLabel(fp, l)
DoDiskCommand(certDisk, cb, d, vda, fp, l>>DL.pageNumber, action)
while @cbz>>CBZ.queueHead ne 0 do GetDiskCb(certDisk, cbz)
resultis cbz>>CBZ.currentPage
]

//----------------------------------------------------------------------------
and XferCleanup(disk, cb, cbz) be
//----------------------------------------------------------------------------
[
MoveBlock(cbz>>CBZ.client, cb>>CB.headerAddress, 2)
cbz>>CBZ.currentPage = cb>>CB.status
]

//----------------------------------------------------------------------------
and XferError(nil, cb, nil) be
//----------------------------------------------------------------------------
[
let disk = cb>>CB.cbz>>CBZ.disk
let rda = cb>>CB.diskAddress
let vda = VirtualDiskDA(disk, lv rda)
PutTemplate(dsp, "*NHard error at BFS$D VDA $UO = Unit $D Cylinder $3F0D Head $D Sector $2F0D",
		certPartition, vda, rda<<DA.disk, rda<<DA.track, rda<<DA.head,
		rda<<DA.sector)
Ws("*NAttempted action was")
for i = 1 to 3 do
   [
   let action = selecton i into
      [
      case 1: cb>>CB.command.headerAction
      case 2: cb>>CB.command.labelAction
      case 3: cb>>CB.command.dataAction
      ]
   action = selecton action into
      [
      case 0: "read"
      case 1: "check"
      case 2: case 3: "write"
      ]
   let record = selecton i into
      [
      case 1: "header"
      case 2: "label"
      case 3: "data"
      ]
   PutTemplate(dsp, " $S $S", action, record)
   ]
Ws("*NResulting status was")
let dst = cb>>CB.status
if dst<<DST.seekFail then Ws(" seek failed")
if dst<<DST.seeking then Ws(" seeking")
if dst<<DST.notReady then Ws(" disk not ready (on?)")
if dst<<DST.dataLate then Ws(" data late")
if dst<<DST.noTransfer then Ws(" no transfer")
if dst<<DST.checksumError then Ws(" checksum error")
if dst<<DST.finalStatus then Ws(selecton dst<<DST.finalStatus into
   [
   case 1: (dst&360b)? "", " sector late"
   case 2: " check error"
   case 3: " illegal sector"
   ])
]

//----------------------------------------------------------------------------
and MyIdle() be
//----------------------------------------------------------------------------
[
let MulDiv = table
   [
   055001B	// sta 3 savedPC,2
   155000B	// mov 2 3
   111000B	// mov 0 2
   102460B	// mkzero 0 0
   061020B	// mul
   031403B	// lda 2 3 3
   061021B	// div
   077400B	// Swat
   121000B	// mov 1 0
   171000B	// mov 3 2
   035001B	// lda 3 savedPC,2
   001401B	// jmp 1,3
   ]
@mouseX = 200 + 200*diskAddress>>DA.disk
@mouseY = diskAddress>>DA.track ls 0? 0,
 20 + MulDiv(808-40-16, diskAddress>>DA.track, 406)
]

//----------------------------------------------------------------------------
and Confirm(prompt) = valof
//----------------------------------------------------------------------------
[
Ws(prompt)
switchon Gets(keys) into
   [
   case $Y: case $y: case $*N:
      [ Ws("Yes"); resultis true ]
   case $N: case $n: case $*177:
      [ Ws("No"); resultis false ]
   default:
      [ Ws("(Y or N) "); loop ]
   ] repeat
]

and AltoVersion() = valof
[
	resultis (table [ 61014b; 1401b ])(origPartition)
]

and ChangePartition(partNumber) = valof
[
	resultis (table [ 61037b; 1401b ])(partNumber)
]

and MyErr(p1, errCode) be
[
	ChangePartition(origPartition)
	PutTemplate(dsp, "*NSystem error $D", errCode)
	abort
]

and MyCleanUp(code) be
[
	ChangePartition(origPartition)
	Closes(logFile)
	@lvIdle = savedIdle
	@lvUserFinishProc = savedUFP
]