-- File TfsBase2.mesaGWilliamsJuly 30, 1981 3:26 PM
--added check at beginning of DefaultTfsCleanupRtn
--changed DefaultTfsCleanupRtn to get core address of ...cb.truePageNumber-1 rather
-- than rely on Mesa indexing (won’t index a -1)
--N.B. that there is no micro-code linkage to TfsModShift at the moment
DIRECTORY

InlineDefs: FROM "inlinedefs" USING [BITOR, BITAND, BITNOT, BITXOR, BITSHIFT, DIVMOD],
MiscDefs: FROM "miscdefs" USING [Zero],
RamDefs: FROM "ramdefs" USING [StartIO],
TridentDefs: FROM "tridentdefs"; -- USING nearly everything

TfsBase2: PROGRAM
IMPORTS InlineDefs, MiscDefs, RamDefs, TridentDefs
EXPORTS TridentDefs =

BEGIN OPEN InlineDefs, RamDefs, TridentDefs;

--
--
Temp procedure to read ticks from real time clock
-- (Has to be here because its machine code)

DriveHung:
PUBLIC ERROR = CODE;
DefaultTfsCleanupRtn: PUBLIC PROCEDURE [disk: tfsdskPtr, cb: cbPtr, cbz: cbzPtr] =

-- This default TFS cleanup routine substitutes the actual virtual Disk Address for each instance of fillInDa in the DAs vector.

BEGIN
temp: dlPtr;-- pointer to label
addr: DA;-- disk address
prevDaPtr: POINTER TO PAGE;

IF cbz.daS = NIL THEN RETURN;--there are occasions where there is no daS
IF (cbz.daS)[cb.truePageNumber + 1] = fillInDA
THEN (cbz.daS)[cb.truePageNumber + 1] ← cbz.nextDA;-- put in next if unknown

prevDaPtr ← @cbz.daS[cb.truePageNumber] - 1;
IF prevDaPtr↑ = fillInDA THEN
BEGIN
temp ← cb.kcb.blockL.addr;-- get pointer to label
addr ← temp.previous;-- get previous disk address
prevDaPtr↑ ← disk.dsk.VirtualDiskDA[disk, @addr];
END;
END;
-- of DefaultTfsCleanupRtn

NoopTfsCleanupRtn: PUBLIC PROCEDURE [disk: tfsdskPtr, cb: cbPtr, cbz: cbzPtr] =
--
-- A do-nothing clean-up routine
BEGIN
END;
-- of NoopTfsCleanupRtn


DefaultTfsErrorRtn: PUBLIC PROCEDURE [addr: POINTER, arg: UNSPECIFIED, ec: CARDINAL] =

-- This is the default error routine. The code we have now replaces an ERROR.

BEGIN
ERROR BadErrorRtn;-- was ERROR BadErrorRtn
END;


-- The procedures below are stored in the disk object in place of those procedures which would modify the disk. This is done when "initmode" is false during startup.


TfsCantCreateDiskFile: PUBLIC PROCEDURE [tfsDsk: tfsdskPtr, name: STRING, filePtr, dirFP: POINTER TO FP, word1: WORD, useOldFP: BOOLEAN, pageBuf: POINTER TO LD] =

BEGIN
ERROR CantModDisk;
END;

TfsCantDeletePages
: PUBLIC PROCEDURE [tfsDsk: tfsdskPtr, cA: POINTER, firstDA: PAGE, fp: FP, newFP: FP, firstPage, hintLastPage: CARDINAL] =

BEGIN
ERROR CantModDisk;
END;

TfsCantAssignDiskPage
: PUBLIC PROCEDURE [disk: tfsdskPtr, diskAddr: PAGE, test: BOOLEAN] RETURNS [resPage: PAGE] =

BEGIN
ERROR CantModDisk;
END;

TfsCantReleasePage
: PUBLIC PROCEDURE [tfsDsk: tfsdskPtr, vda: VDA] =

BEGIN
ERROR CantModDisk;
END;




BadCommand: PUBLIC ERROR = CODE;-- bad action code (TfsDoDiskcommand)
BadQueue: PUBLIC ERROR = CODE;-- CBZ queue error (TfsGetcb)
BadErrorRtn: PUBLIC ERROR = CODE;-- This is the default error routine
CantModDisk: PUBLIC ERROR = CODE;-- Can’t write on disk (TfsSetDisk)
Aretry: SIGNAL = CODE;


TfsVirtualDA: PUBLIC PROCEDURE [disk: tfsdskPtr, dskAddr: dAPtr] RETURNS [dA: PAGE] =

-- Produces a virtual disk address given a real one.
-- Returns fillInDA if the real DiskAddress is not contained in this file system.
-- Returns eofDA for physical page zero (this facilitates EOF detection).
-- dskAddr is a pointer to a real disk address (track, head, sector).
-- This procedure is stored as DefaultTfsCleanupRout in the CBZ, and is executed
-- at the exit of TfsGetcb

BEGIN

track: CARDINAL;

IF dskAddr↑ = [0,0,0] THEN RETURN [eofDA];
-- diskaddress[word,byte,byte]=0
IF dskAddr.track<disk.tfskd.firstVTrack THEN RETURN [fillInDA]; --track too small
track ← dskAddr.track - disk.tfskd.firstVTrack;
IF track >= disk.tfskd.nVtracks
-- see if diskaddr is too big
OR dskAddr.head >= disk.tfskd.kdh.nHeads
OR dskAddr.sector >= disk.tfskd.kdh.nSectors
THEN dA ← fillInDA-- if not, calculate Virtual DA
ELSE
dA←(track*disk.tfskd.kdh.nHeads + dskAddr.head)*disk.tfskd.kdh.nSectors + dskAddr.sector;
RETURN [dA];
END;
-- of TfsVirtualDA

TfsRealDA: PUBLIC PROCEDURE [disk: tfsdskPtr, dA: PAGE] RETURNS[dskAddr: DA] =
--
-- Given virtual disk address dA, this routine produces a real disk address.

BEGIN

quotient: INTEGER;

IF dA=eofDA THEN RETURN[dskAddr ← DA[0,0,0]];--June 24, 1981 2:58 PM
dskAddr.sector ← dA MOD disk.tfskd.kdh.nSectors;-- IN [0..8]
quotient ← dA/disk.tfskd.kdh.nSectors;
dskAddr.head ← quotient MOD disk.tfskd.kdh.nHeads;
dskAddr.track ← quotient/disk.tfskd.kdh.nHeads;
RETURN[dskAddr];

END;
-- of RealDiskDA


TfsDoRecovery: PUBLIC PROCEDURE [disk: tfsdskPtr, command: CARDINAL, coax: BOOLEAN ← FALSE] =

-- I/O error recovery code called from TfsGetcb and TfsInit.
--
--Coax is an option which will cause the Trident microcode to be restarted (via StartIO). The option is provided for those transfers which time out. It may be that we have inadvertently selected a non-existent drive. This also handles the case where the presently-selected drive has been taken off-line, and no more sector pulses are arriving. So be prepared to provide some fake sector pulses via StartIO.

--
The -1’s in various places are crucial. This routine forces a drive re-select to be safe. The microcode will set KBLK.track to -1 in this case. Consequently, we set KCB.track = -1 so that no seek will be done as part of the recovery. However, because KBLK.track is -1, a seek (usually very short) will be done on the very next command issued.

--Also, there is a bug in the controller such that if you issue a Read and the drive doesn’t send you any data (e.g., because it’s in select lock or the pack has been DC-erased), the controller gets hung up waiting for the sync bit. The only safe way to get out of this state is to reset the controller, turn it back on, and issue a diskReset.


BEGIN

kcb: KCB;
-- a KCB
v: kcbPtr;
-- KCB pointer
hiTen: WORD = 177700B;
-- high ten bits
retryCount: CARDINAL;
-- # of error retries
notunReady: WORD = BITNOT[2000B];
-- not ready bit of status word is off
status: WORD;
-- receptacle for status bits

WHILE tfsLock DO NULL ENDLOOP;
-- wait for other commands to stop
tfsLock ← TRUE;
-- (bcpl routine store tfsddkPtr here)
TfsWaitQuiet[FALSE];
-- wait for disk to become idle
v ← @kcb;
-- allocate storage for KCB
retryCount ← 0;
-- initialize counter

DO
-- perform this loop until all errors go away
IF coax THEN-- start Trident microcode(sector pulses)
[] ← StartIO[20B];-- turn off run-enable
retryCount ← retryCount + 1;
IF BITAND[retryCount, 17B] = 0 THEN ERROR DriveHung;
MiscDefs.Zero[v, lKCB];-- initialize temporary KCB
v.id ← dcbID;-- initialize the disk seal
v.diskAddress.track ← -1;-- force a seek on the next command
v.drive ← disk.dsk.driveNumber;-- use the current drive number
v.blockH.comm ← command;-- store the I/O command (argument)

track↑ ← -1;
drive↑ ← BITOR[disk.dsk.driveNumber, 100000B];--force drive select
abort↑ ← 0;-- reset aborted field

ptr↑ ← v;-- store the pointer to KCB we built

IF coax THEN [] ← StartIO[40B];-- start Trident microcode
TfsWaitQuiet[command=diskRestore];-- arg=TRUE if diskRestore


--If the command timed out, sector pulses may have gone away.
--Issue the command more forcefully next time through if so.

IF v.blockH.status = dstZeroStatus OR v.id = dcbID
THEN coax ← TRUE
ELSE
BEGIN -- notReady in KCB happens normally if command = diskRestore
status ← BITOR[statusptr↑, BITAND[v.blockH.status, notunReady]];
IF ((0 = BITAND[status, hiTen]) AND ~coax) THEN EXIT;
coax ← FALSE;

-- certain errors need a restore to reset
-- if we didn’t succeed in resetting one, try a restore next time
IF 0 # BITAND[status, dstRestoreBits] THEN command ← diskRestore;
END;
ENDLOOP;
tfsLock ← FALSE;
-- allow other commands

END;
-- of TfsDoRecovery

TfsWaitQuiet: PUBLIC PROCEDURE [awaitIndex: BOOLEAN] =

--Wait until the disk is thoroughly idle. Evidence for idle is:
--
1.ptr↑ (640↑) is zero, i.e. - no commands remain
--
2.The low-order 4 bits of statusptr↑ (643↑) are counting, i.e. - we’re not writing
--
3.statusptr↑ has gone one cycle, i.e. - read task is definitely finished

--
The reason for waiting is that if we issue a reset (executed by the write task) while the read task is still active, we will disappear forever. Also we should note that after a restore is executed, it takes a while for sector pulses to start arriving again.

BEGIN

stage: CARDINAL ←0;

timer: INTEGER ← 0;
-- make sure we wait long enough
lastPtr: POINTER;
sector: [0..9) ← 0;

lastPtr ← LOOPHOLE[-1];
-- impossible value for ptr
DO
SELECT stage FROM

0 =>
BEGIN
-- Wait for cb queue to empty, but time out if a single command stays
-- on the queue for more than 500 ms.
IF ptr↑ # lastPtr THEN
BEGIN
lastPtr ← ptr↑;--save command pointer
timer ← RTC↑ + 500/39;-- set timer
END;
IF ptr↑ = NIL THEN stage ← 1;-- go on to the next step
END;

1 =>
BEGIN
-- Wait for restore to complete
IF NOT (awaitIndex AND (1=statusptr.notReady)) THEN
BEGIN
sector ← statusptr.sector;-- get this sector
timer ← RTC↑ + 1;-- set timer for 39 ms
stage ← 2;
END;
END;

2 =>
BEGIN
-- Wait for sector # to advance, but time out after 39ms (2 revs)
IF statusptr.sector # sector THEN
BEGIN
IF NOT awaitIndex THEN EXIT;
stage ← 3;
END;
END;

-- IF we did a restore, wait for index mark (sector 0)
3 => IF statusptr.sector = 0 THEN EXIT;
ENDCASE;
-- there was an Idle here
IF (RTC↑ - timer) > 0 THEN EXIT;
ENDLOOP;
ptr↑ ← NIL;
-- in case microcode didn’t do anything


END;
-- of TfsWaitQuiet


TfsModShift: PROCEDURE [num, ref: INTEGER] RETURNS [s1: INTEGER] =

--The microcode version of this routine shares S registers with the Read task.
--
Therefore, call this only when the disk is quiet.

BEGIN
--July 8, 1981 11:44 AM changed the AND to an OR in 1st line of loop
s1 ← 0;
DO
--IF (4000B - s1 < 0) AND (num - ref = 0) THEN EXIT;
IF (4000B - s1 < 0) OR (num - ref = 0) THEN EXIT;
num ← BITSHIFT[num, Left*1];
IF BITAND[num, 4000B] # 0 THEN num ← BITXOR[num, 4005B];
s1 ← s1 + 1;
ENDLOOP;
RETURN[s1];

END;
-- of TfsModShift
--page

DataFix: PUBLIC PROCEDURE [block: kcblockPtr] RETURNS[result: INTEGER] =

--
ECC fixer. The argument is a pointer to a disk command block for a single
--
block, not a sector. Returns a -1 if everything fixed correctly. Otherwise
--
number is returned indicating where the ECC gave up

BEGIN

lcm: CARDINAL ← 21*2047;
rem0, rem1, msb: WORD;
s0, s1, dx, d, dbits, mask: WORD ← 0;
quotient: CARDINAL;
ptrr, p: INTEGER ← 0;
integCount: INTEGER;
data: POINTER ← NIL;

rem0 ← BITAND[block.ecc0, 37B];
rem1 ← block.ecc1;

DO
IF BITAND[rem1, 1777B] = 0 THEN EXIT;
msb ← BITSHIFT[rem0, Right*4];
rem0 ← BITAND[BITSHIFT[rem0, Left*1], 37B] + BITSHIFT[rem1, Right*15];
rem1 ← BITSHIFT[rem1, Left*1] + msb;
s0 ← s0 + 1;
IF s0 >= 21 THEN RETURN[1];
ENDLOOP;

rem0 ← BITSHIFT[rem0, Left*6] + BITSHIFT[rem1, Right*10];
rem1 ← BITAND[block.ecc0, Right*5];
IF rem1 = 0 OR rem0 = 0 THEN RETURN[2];

s1 ← TfsModShift[rem1, rem0] + 11;
IF s1 > 2047+11 THEN RETURN[3];

[quotient, dx] ← DIVMOD[((-19*s0 - 2*s1)+220*21), 21];
d ← 2048*dx - dx - s1 + 2047;
--= d←2047*d + 2047 - s1
--IF d > lcm THEN d ← d - lcm;
----commented out of BCPL version
dbits ← BITAND[d, 17B];
p ← block.count - BITSHIFT[d, Right*4];
data ← block.addr;
mask ← BITSHIFT[rem0, Right*(16-dbits)];

integCount ← block.count;
-- CARDINAL to INTEGER
FOR ptrr IN [p..p+1] DO
IF mask # 0 THEN
BEGIN
IF ptrr < 0 THEN RETURN[4];-- error is outside block
IF ptrr < integCount THEN (data+ptrr)↑ ← BITXOR[(data+ptrr)↑, mask];
-- error possibly in ECC words
END;
mask ← BITSHIFT[rem0, Left*dbits];
ENDLOOP;

RETURN[-1];

END;
-- of DataFix



END.
-- of TfsBase2