[Pixel]<Images>mesatfs>Sources>TfsBase1.mesa!1

NullRoutine: PROCEDURE[]=BEGIN i: INTEGER; i ← 0;END;
TfsInitializeCBStorage: PUBLIC PROCEDURE [disk: tfsdskPtr, cbz: cbzPtr, firstPage: INTEGER, length: CARDINAL, retry: RetryType, errorRtn: ErrorRoutType ← DefaultTfsErrorRtn] =

-- Initialize the cbz such that it can be used for TFS disk Transfers
-- This procedure is called by TfsActOnPages
-- defaultError = TRUE means use the default error routine

BEGIN
temptr,cb: cbPtr;-- pointer to CB queue
cbPos,cbzPos: CARDINAL;-- to determine where we are in zone

IF length # 0 THEN-- was IF numarg >= 4 THEN
BEGIN
MiscDefs.Zero[cbz, length];-- erase the buffer
cbz.length ← length;-- store size of buffer
cbz.errorRtn ← errorRtn;
cbz.retry ← retry;--this was a goto address
cbz.cleanupRoutine ← DefaultTfsCleanupRtn;
END;

cbz.disk ← disk;-- store disk object pointer
cbz.currentPage ← firstPage;-- set up starting page number
cbz.queueHead ← @cbz↑.head;-- queueHead points to Head
cb ← LOOPHOLE[cbz,cbPtr]+lCBZ;
cbz.head ← cb;-- store pointer in queue head
cbzPos ← LOOPHOLE[(cbz+(cbz.length-1))];-- where end of core is

DO-- this is a BCPL repeatuntil cb eq 0...
cbz.tail ← cb;-- store pointer to CB queue in queue tail
cb.cbz ← cbz;-- store CBZ pointer in this CB
cb.kcb.blockH.status ← dstFree; -- set sector=1’s + defaults
cb ← cb + lCB;-- point to next CB, if possible
cbPos ← LOOPHOLE[cb + lCB];-- where the next next CB will start
IF cbPos > cbzPos THEN cb ← NIL;
-- if CB after next CB is not possible, ptr = 0
temptr ← cbz.tail;-- retrieve the CB queue tail
temptr.nextCB ← cb;-- store pointer to next CB there
IF cb = NIL THEN EXIT;-- if no more CB’s are possible, quit
ENDLOOP;

END;-- of TfsInitializeCBStorage

TfsDoDiskCommand: PUBLIC PROCEDURE [disk: tfsdskPtr, cb: cbPtr, cA: POINTER, dA: PAGE, fp: FP, pageNumber: INTEGER, action: CARDINAL, nextCB: cbPtr] =

-- Expects command and label to be zeroed on entry or otherwise appropriately initialized.
--This procedure is called by TfsActOnPages. dA is a virtual disk address of the type produced by TfsVirtualDA

BEGIN
cbz: cbzPtr;-- pointer to command block zone
la: dlPtr;-- pointer to label (KCB.addrL) or (DL)
actNumber: INTEGER;-- Disk command, in the range [0..10]
p: kcbPtr;-- KCB pointers
temptr: cbPtr;-- for fixing up CB chain

cbz ← cb.cbz;-- get cbz pointer (put there by TfsInitializeCBstorage)

-- TFSbase.bcpl has code here about setting normal and error wakeups if interrupts are ever implemented.

--Set up header block part of sector transfer
cb.kcb.blockH.addr ← LOOPHOLE[@cb.kcb.diskAddress];--pointer to (cylinder,head,sector)
cb.kcb.blockH.count ← lDH;-- store length of header

-- set up label part of sector transfer. The pointer to the label is in
-- 1 of 3 places:
--1. given, i.e. cb.kcb.addrL is not NIL
--2. in label field of this CB
--3. in the label field of the next CB.

la ← cb.kcb.blockL.addr;-- caller may want label to go elsewhere
IF la = NIL THEN
BEGIN
IF nextCB = NIL THEN la ← @cb.label
ELSE la ← lDH + @nextCB.label;
cb.kcb.blockL.addr ← la;-- store the label block pointer
END;
cb.kcb.blockL.count ← lDL;-- store the count for label

-- set data block part of sector transfer
cb.kcb.blockD.addr← cA;-- store address of data block
cb.kcb.blockD.count ← TFSwordsPerPage;-- fixed data block size

-- set up for label compare ( COPY [from, length, to])

InlineDefs.COPY[@fp, lFID, la];-- copy file ID part of label(???)
la.packID ← disk.tfskd.packID;-- store pack ID
la.pageNumber ← pageNumber;-- caller’s pagenumber
cb.truePageNumber ← pageNumber;-- store it in CB, too

-- Put in the disk address for this command.
--If DA equals fillinDA, the disk address has already been set up, or it will be filled in from the previous disk transfer.
IF dA # fillInDA THEN cb.kcb.diskAddress ← TfsRealDA[disk, dA];
cb.vDiskAddress ← dA;-- put diskaddress in CB

-- Fill in the actual disk action for each block of the sector
actNumber ← action - diskMagic;-- take off high bits
IF actNumber NOT IN [0..10] THEN ERROR BadCommand;
cb.kcb.blockH.comm ← headerComds[actNumber];
cb.kcb.blockL.comm ← labelComds[actNumber];
cb.kcb.blockD.comm ← dataComds[actNumber];

cb.kcb.drive ← disk.dsk.driveNumber;-- Fill in the drive Number and command seal

-- wait for interlocked activity (TfsDoRecovery, TfsTryDisk, etc. to complete
WHILE tfsLock DO NULL ENDLOOP;

-- Turn off the display if not already off
IF tfsSavedDisplay = 177777B THEN-- -1 => display not saved
BEGIN
tfsSavedDisplay ← DAstart↑;
IF NOT tfsLeaveDisplay THEN DAstart↑ ← 0;
END;

-- Enqueue the command
cb.kcb.id ← dcbID;-- Store the disk seal
p ← ptr↑;-- get the pointer stored at 640

IF p # NIL THEN-- If that pointer isn’t zero then
BEGIN-- chase down the chain
UNTIL p.nextKCB = NIL DO-- loop until no next KCB
p ← p.nextKCB;-- get the pointer to the next KCB
ENDLOOP;

-- Next line: the nextKcb pointer should be updated with the pointer to the Kcb in the CB which was passed to us

p.nextKCB ← @cb.kcb; -- put in pointer to kcb (in this CB)
END;-- of IF p # NIL block

IF ptr↑ = NIL
THEN ptr↑ ← @cb.kcb.diskAddress; -- fix up 640 if necessary

cb.nextCB ← NIL;-- Put this CB back on the available queue
IF cbz.head = NIL THEN cbz.head ← cb
ELSE BEGIN
temptr ← cbz.tail;-- get pointer from tail
temptr.nextCB ← cb;-- and store pointer to CB in nextCB
END;
cbz.tail ← cb;-- set pointer to tail
END;-- of DoDiskCommand

TfsGetCb: PUBLIC PROCEDURE [disk: tfsdskPtr, cbz: cbzPtr, dontClear,returnIfNoCb: BOOLEAN ← FALSE]
RETURNS [cb: cbPtr] =

-- gets the next command buffer (CB) from the command buffer zone (CBZ), waits on command completion, does error recovery
--if necessary, and keeps statistics. Returns a pointer to command buffer (CB). This procedure generates a SIGNAL, which really
--behaves as a GOTO. So without returning, this procedure may branch directly to the beginning of the main loop in TfsActOnPages.

BEGIN

dsAddr: POINTER TO Status;-- pointer to kcb status words
compTest, diskStatus: Status;-- catch all for status blocks
errorStatus, tempStatus: Status;
errorCount: CARDINAL;-- temp for TFSDSK.nErrors
block: kcblockPtr;-- pointer to KCB command block
inTime: INTEGER;-- holder for real time clock
eccLoop: CARDINAL;-- loop counter for ECC correction
--temp: dlPtr;---- pointer to label
--addr: DA;---- hardware disk address
hiTen: WORD = 177700B;-- all the error bits in status word
p: kcbPtr;-- pointer to 640B
z: CARDINAL;

cb ← cbz.head;-- dequeue the next CB from CBZ
IF cb = NIL THEN
BEGIN
IF returnIfNoCb THEN RETURN [NIL]
ELSE ERROR BadQueue;-- there should have been a CB
END;
cbz.head ← cb.nextCB;-- fix head pointer to next CB
-- If the header has good status, we may use CB
IF cb.kcb.blockH.status = dstFree THEN
BEGIN
MiscDefs.Zero[cb, lVarCb];-- length = lDL+lKCB+1 (offset to CBZ pointer)
RETURN [cb];-- return the cb Pointer and exit
END;
--Many ways to return a good cb
DO--main loop---- Once we exit from this loop, we’re done
-- note that code below depends on the fact that the
-- label is always transferred, tho data may not.
IF cb.kcb.blockD.comm = 0
THEN dsAddr ← @cb.kcb.blockL.status
ELSE dsAddr ← @cb.kcb.blockD.status;-- get a disk status address

-- Wait here for command completion

diskStatus ← dsAddr↑;-- get the status of this command
IF diskStatus = dstZeroStatus
THEN
{IF returnIfNoCb THEN {cbz.head ← cb; RETURN [NIL];};-- return cb = 0

inTime ← RTC↑;-- wait for command to complete or 5 seconds
DO--check status--
FOR zz: CARDINAL IN [0..6] DO z←z+1; z←z-1; ENDLOOP; --Idle()
diskStatus ← dsAddr↑;-- get the status of this command
IF diskStatus # dstZeroStatus THEN EXIT;--command completed.
p ← ptr↑;--look at 640 for activity
IF p=NIL AND cb.kcb.id = dcbID THEN {dsAddr↑ ← BITOR[dstForgotten, dstDone]; EXIT};
IF (RTC↑ - inTime) > 5*27 THEN
--command timed out and controller seems to be hung up
{dsAddr↑ ← BITOR[dstTimeout, dstDone]; EXIT};
ENDLOOP;
};

--compileif debug then {} was here in BCPL ver

-- combine status of all the blocks for this transfer. THEN if there are no errors finish up and return the pointer to CB.
--If status has not been set, then 1.) The command aborted, 2.) the read task quit, or 3.) sector pulses are not present.

IF errorStatus = dstZeroStatus THEN EXIT;

-- Error Recovery
-- The disk must be reset after each error, but do not tamper with the zone. Note that other disk activity can be taking place.
--We might just have an ECC error and can fix it without flushing the remainder of the command block chain.

TfsDoRecovery[disk, diskReset, FALSE];-- reset the error

--retry data-late and "forgotten" errors indefinitely, without any other recovery actions, and without counting them as errors.

IF BITAND[errorStatus, dstRetryIndefinitely] = 0 THEN
BEGIN --LONG BLOCK!
cbz.errorCount ← cbz.errorCount + 1;-- keep retrying data late errors
errorCount ← cbz.errorCount;

-- The disk should be quiet now. Do error correction stuff if this is not the first retry ...
-- Never report data-late errors, and report check errors only after they have been retried at least once since
--EOF is detected by slamming into page zero and getting a check error

compTest ← BITAND[diskStatus, 100B];--want to save CompErr bit only
IF ~(errorCount =1 AND errorStatus = dstCompErr)THEN
BEGIN
disk.tfskd.nErrors ← disk.tfskd.nErrors + 1; -- TfsIncrement...
block ← @cb.kcb.blockH;-- get pointer to cmd block
errorStatus ← dstZeroStatus;-- set status = Good (init)

-- ECC: attempt this only if there are no other errors in this block. This
-- includes check errors, since the first two words of a checked block are
-- not stored in memory.

FOR eccLoop IN [1..3] DO-- attempt ECC corr. for header, label, data
tempStatus ← BITAND[block.status, dstErrors];-- get status of this block
IF tempStatus =dstECCerror
THEN
BEGIN-- ECC error fixing block
disk.tfskd.nECCErrors ← disk.tfskd.nECCErrors + 1;-- bump ECC err ctr
IF errorCount >= 4 AND DataFix[block] = -1 THEN
{-- -1 means fixed, so set status = 0
tempStatus ← dstZeroStatus;-- and bump ECC fix ctr
disk.tfskd.nECCFixes ← disk.tfskd.nECCFixes + 1;
};-- end ECC counter block
END;-- end ECC error fixing block

errorStatus ← BITOR[tempStatus, errorStatus];-- put in ECC status
block ← block + lKCBblock;-- increase pointer
ENDLOOP;-- ECC error recovery loop

IF errorStatus = dstZeroStatus THEN EXIT; -- done with successful ECC error recovery,
END;-- end of recoverable errors

-- Non-recoverable error check
--Turn display back on now, since error routine might signal
IF tfsSavedDisplay # 177777B THEN
BEGIN
DAstart↑ ← tfsSavedDisplay;-- Restore display
tfsSavedDisplay ← 177777B;-- Indicate not saved
END;

cbz.errorDA ← cb.vDiskAddress;-- store disk address
IF errorCount >= disk.dsk.retryCount THEN
BEGIN --non-recoverable error
disk.tfskd.nUnRecov ← disk.tfskd.nUnRecov + 1;-- bump counter
cbz.errorRtn[@cbz.errorRtn, cb, ecUnRecovDiskError]; --default currently signals
EXIT; --from main loop---- let remainder of transfers go through
END;
-- After retry count gets high enough, do a restore before trying again

IF errorCount > BITSHIFT[disk.dsk.retryCount, Right*1] THEN
BEGIN
-- Check for a read-only error.. We do this after 8 retries (rather
-- then immediately) because the hardware doesn’t provide an unequivocal
-- "tried to write when read-only" indication. Also, we must do a
-- restore after the error routine returns in order to force the drive
-- to notice the new state of the switch.
-- Note that the ReadOnly bit has been masked out in errorStatus, but the status stored on top of the ID contains the
-- true state of the ReadOnly switch.
diskStatus ← LOOPHOLE[cb.kcb.id, Status];
IF (diskStatus.readOnly = 1) AND (errorStatus.deviceCk = 1) THEN
cbz.errorRtn[@cbz.errorRtn, cb, ecReadOnly];
disk.tfskd.nRestores ← disk.tfskd.nRestores + 1;
TfsDoRecovery[disk, diskRestore, FALSE];
END;
END;--of LONG BLOCK
-- Initialize again (FALSE means do not use the last argument)

TfsInitializeCBStorage[disk, cbz, cb.truePageNumber, zoneLeng, cbz.retry, cbz.errorRtn];

SIGNAL cbz.retry;-- We want to ReturnTO [cbz.retry] in calling routine.

ENDLOOP;-- of main loop

-- Exits from the main loop end up here; ready to return good cb from previous transfer.
p ← ptr↑;
IF p = NIL AND tfsSavedDisplay # 177777B THEN
{DAstart↑ ← tfsSavedDisplay;-- Restore display
tfsSavedDisplay ← 177777B};-- Indicate not saved
disk.tfskd.nTransfers ← disk.tfskd.nTransfers + 1;-- count transfers
--the following 2 lines seem superfluous
--temp ← cb.kcb.blockL.addr;---- get pointer to label
--addr ← temp.next;---- get next disk address
cbz.nextDA ← disk.dsk.VirtualDiskDA[disk, @cb.kcb.blockL.addr.next];-- convert real to vDA
cbz.currentNumChars ← cb.kcb.blockL.addr.numChars;-- # from label
cbz.errorCount ← 0;
cbz.cleanupRoutine[disk, cb, cbz];-- execute cleanup
IF ~dontClear THEN MiscDefs.Zero[cb, lVarCb];

END;-- of TfsGetCB

TfsActOnPages: PUBLIC PROCEDURE [disk: tfsdskPtr, caS: DESCRIPTOR FOR ARRAY OF POINTER, daS: DESCRIPTOR FOR ARRAY OF PAGE, fp: FP, firstPage, lastPage: INTEGER, action: CARDINAL, numcharsPtr: POINTER, lastAction: CARDINAL, fixedCA: POINTER, cleanupRoutine: CleanUpRoutType, errorRtn: ErrorRoutType ← DefaultTfsErrorRtn, returnOnCheckError: BOOLEAN, hintLastPage: INTEGER] RETURNS [resPage: INTEGER] =

-- Returns the last page successfully acted on.
--caS and daS are ARRAYs indexed by page number (e.g. caS[firstPage])
--The arguments following action are optional; if one of them is zero or NIL
--a default action is taken. DefaultTfsCleanupRoutine should be used if you don’t have a favorite.
-- Either one of caS or fixedCA is used. If fixedCA is non-zero it is used, otherwise caS is used.

--Procedure was temporarily changed to optionally record I/O times in caS, an "array of RealTime"

BEGIN

cptr: cbzPtr;-- pointer to cbz
cb: cbPtr;-- pointer to command buffer
nextCB: cbPtr;
thisCBaction: CARDINAL;-- current I/O command
pageNumber: INTEGER;
curFirstPage: INTEGER;-- current first page
temp: POINTER;-- for address calculation

-- Turn off the display if not already off This code has been moved to TfsDoDiskCommand
--IF tfsSavedDisplay = 177777B THEN---- -1 => display not saved
--BEGIN
--tfsSavedDisplay ← DAstart↑;
--IF NOT tfsLeaveDisplay THEN DAstart↑ ← 0;
--END;

IF lastAction = 0 THEN lastAction ← action;
-- build a command buffer zone (CBZ)

cptr ← AllocateHeapNode[zoneLeng];-- allocate core for CBZ
TfsInitializeCBStorage[disk,cptr,firstPage,zoneLeng,Aretry, errorRtn];
--cptr.daS ← daS;---- store disk address descriptor
--cptr.cleanupRoutine ← cleanupRoutine;---- store cleanup routine
--moved above code into the signal-catching block

IF hintLastPage NOT IN[firstPage..lastPage]
THEN hintLastPage ← lastPage;

--Each command buffer (CB is used twice: to hold the disk label (DL) for page i-1 and to hold the disk command block (KCB) for page i.
--It isn’t reused until the command for page i is done, and that is guaranteed to be after the DL for page i-1 is no longer needed, since
--everything is done strictly sequetially by page number.

--Note: If the hintLastPage looks reasonable and is less than lastPage, we transfer pages up to that point, then check to see whether the
-- last page transferred really was the last page of the file. If so, we return without having caused the disk to seek to cylinder zero as a
-- result of chaining forward from the last page. If the hint was wrong we have to queue up the remainder of the transfers; this causes
-- an extra disk rotation.

--This is the point from which retries are started (from TfsGetcb)
--Aretry:

DO ENABLE Aretry => CONTINUE;-- CONTINUE means go around the loop again
cptr.daS ← daS;-- store disk address descriptor
cptr.cleanupRoutine ← cleanupRoutine;-- store cleanup routine
resPage ← hintLastPage;-- right now last successful page is hintLastPage
cb ← TfsGetCb[disk, cptr, FALSE, FALSE];-- get a 1st CB

-- pointer (after having called TfsInitializeCbStorage, the CB’s have status = dstFree.
--Under those conditions, TfsGetcb will exit right after getting the CB for us).

curFirstPage ← cptr.currentPage;-- set the current first page

FOR pageNumber IN [curFirstPage..hintLastPage]
DO
IF daS[pageNumber] = eofDA
THEN {resPage ← pageNumber-1; EXIT}; -- Last page has been fixed

thisCBaction ← action;-- implement the above comment
IF pageNumber = lastPage AND thisCBaction # lastAction THEN
BEGIN
IF curFirstPage # lastPage THEN
{resPage ← pageNumber-1; EXIT;};--exit from inner loop
thisCBaction ← lastAction;
END;

IF thisCBaction = dcDoNothing THEN LOOP;-- 7+DiskMagic (Noop)

-- Non-recoverable error(s) check...

IF returnOnCheckError AND cptr.errorCount=BITSHIFT[disk.dsk.retryCount,Right*1]
THEN RETURN[-(pageNumber+77B)];-- RETURN on check error

-- If we are chaining then cause this command to fill in
-- the disk address portion of the next command

nextCB ← TfsGetCb[disk, cptr, FALSE, FALSE];-- get the next CB
IF daS[pageNumber+1] = fillInDA-- If an error, GOTO Aretry
THEN
{temp ← @nextCB.label;-- pointer to next CB’s label
cb.kcb.blockL.addr ← temp + lDH;-- displace to diskaddr part of KCB
}
ELSE cb.kcb.blockL.addr ← @nextCB.label;-- point to next label

IF thisCBaction IN [dcReadHLD..dcWriteD]--do we need a core pointer?
THEN
temp ← (IF (fixedCA # NIL) THEN fixedCA ELSE caS[pageNumber]);

TfsDoDiskCommand[disk,cb,temp,daS[pageNumber],fp,pageNumber,thisCBaction,NIL];--queue the transfer
cb ← nextCB;
ENDLOOP;

WHILE cptr.head # NIL
DO-- wait for I/O to finish
temp ← TfsGetCb[disk, cptr, FALSE, FALSE];-- GOTO Aretry on error by raising Signal
ENDLOOP;

IF resPage = lastPage OR daS[resPage+1] = eofDA THEN EXIT;
hintLastPage ← lastPage;
TfsInitializeCBStorage[disk,cptr,resPage+1,zoneLeng,Aretry, errorRtn];

ENDLOOP;-- end of largest loop

-- Clean up
IF numcharsPtr # NIL THEN
numcharsPtr↑ ← cptr.currentNumChars;-- store number of characters
FreeHeapNode[cptr];-- free the CBZ
RETURN[resPage];
END;-- of TfsActOnPages