// diexbfs.Bcpl
// New Alto basic file system
//last modified April 20, 1978 12:31 PM by R Bates
//Thsi is not BFS at all!!! I really changed a lot of stuff
// N O T E ! ! ! The whole "disk" object depends on errors of any kind
// stopping subsequent transfers. For example, WriteBlock will in general
// write a page from the stream buffer, write a few pages from core,
// and READ the last page into the stream buffer. If the disk is allowed
// to continue down its chain, even though an error occurred on the first
// (write of stream buffer), the stream buffer will become clobbered with
// bad data from the last page. Retrying will write bad data into the first
// page!!!
//get "AltoFileSys.d" //Definitions of structures in the file system
//get "Disks.d" //Definitions for the "disk class"
get "Diex.defs" //Definitions for driving the Model 31/44 disk
// Outgoing procedures
external
[
// Outgoing procedures
GetCb; InitializeCbStorage; DoDiskCommand
// incoming procedures
Usc; Idle; ReturnTo; DisableInterrupts; EnableInterrupts; DefaultArgs; SysErr
]
manifest
[
ecUnRecovDiskError = 1101
ecBadAction = 1103
ecBfsBug = 1104
//BFSrestoreAndSeek = #525
]
static [ nSectors = 12; nHeads = 2; nTracks = 203 ; nDisks = 1; DiskSel=0 ]
static [ @TP0=0; @TP1=0; @TP2=0; LastCb=0; Aexit ] // *** DELETE FOR TFS.bcpl
//---------------------------------------------------------------------------
let VirtualDA(lvrealDA) = valof
//---------------------------------------------------------------------------
[
let realDA = @lvrealDA
if realDA eq eofDA then resultis eofDA
resultis (((((realDA<<DA.disk * nTracks) + realDA<<DA.track) * nHeads) + realDA<<DA.head) * nSectors) + realDA<<DA.sector
]
//---------------------------------------------------------------------------
and RealDA(virtualDA, lvrealDA) = valof
//---------------------------------------------------------------------------
[
// Div(x) returns virtualDA/x and leaves the remainder in virtualDA
let Div = table
[
#55001 // sta 3 savedPC,2
#25004 // lda 1 firstArg,2
#155000 // mov 2 3
#111000 // mov 0 2
#102460 // mkzero 0 0
#61021 // div
#77400 // Swat
#171000 // mov 3 2
#45004 // sta 1 firstArg,2
#35001 // lda 3 savedPC,2
#1401 // jmp 1,3
]
let realDA = 0
if virtualDA ne eofDA then
[
realDA<<DA.sector = Div(nSectors)
realDA<<DA.head = Div(nHeads)
realDA<<DA.track = Div(nTracks)
realDA<<DA.disk = virtualDA
]
@lvrealDA = realDA
// Return true if disk address appears legal.
resultis (virtualDA ge 0 & virtualDA ls nDisks)
]
//---------------------------------------------------------------------------
let InitializeCbStorage(zone, firstPage, length, retry; numargs na) be
//---------------------------------------------------------------------------
[
if na ge 4 then
[
Zero(zone, length)
zone>>CBZ.length = length
zone>>CBZ.retry = retry
]
zone>>CBZ.currentPage = firstPage
let e = lv zone>>CBZ.queueVec
rv e = 0; zone>>CBZ.queueTail = e
e = e +1; zone>>CBZ.queueHead = e
let cb = zone+zone>>CBZ.length
[
cb = cb-lCB; if Usc(cb,e) le 0 break
cb>>CB.zone = zone
cb>>CB.status = DSTfreeStatus
rv e = cb; e = e +1
] repeat
zone>>CBZ.endQueueVec = e
]
//---------------------------------------------------------------------------
and NextCb(zone, pointer) = valof
//---------------------------------------------------------------------------
[
let t = zone!pointer
let u = t +1
if Usc(u,zone>>CBZ.endQueueVec) ge 0 then u = lv zone>>CBZ.queueVec
zone!pointer = u
resultis t
]
//---------------------------------------------------------------------------
and DoDiskCommand(cb, CA, DA, fp, pageNumber, action) be
//---------------------------------------------------------------------------
// Expects command and label to both be zeroed on entry, or
// otherwise appropriately initialized
[
let z = cb>>CB.zone
cb>>CB.headerAddress = lv cb>>CB.header
let la = cb>>CB.labelAddress
if la eq 0 then
[
la = lv cb>>CB.label
cb>>CB.labelAddress = la
]
if cb>>CB.dataAddress eq 0 then cb>>CB.dataAddress = CA
if cb>>CB.normalWakeups eq 0 then
cb>>CB.normalWakeups = z>>CBZ.normalWakeups
if cb>>CB.errorWakeups eq 0 then
cb>>CB.errorWakeups = z>>CBZ.errorWakeups
if la>>DL.fileId.SNword1 eq 0 then //label data is zero so set Fid to 'unused'
[
la>>DL.fileId.SNword1 = -1
la>>DL.fileId.SNword2 = -1
la>>DL.fileId.version = -1
la>>DL.pageNumber = pageNumber
]
cb>>CB.truePageNumber = pageNumber
// Compute real disk address
//if DA ne fillInDA then RealDA(DA, lv cb>>CB.diskAddress) **gets a real DA
cb>>CB.diskAddress = DA// **gets a real DA
cb>>CB.diskAddress.disk = DiskSel
cb>>CB.header.diskAddress = DA// **gets a real DA
cb>>CB.header.diskAddress.disk = PackType
if action eq BFSrestoreAndSeek then
[
cb>>CB.diskAddress.restore = 1
action = msb rshift offset DC.seekOnly
]
if cb>>CB.diskAddress.restore then @lastDiskAddress = -1
//let actNumber = action-diskMagic
//if actNumber ls 0 % actNumber gr 6 % (action&diskMagicMask) ne diskMagic then
//SysErr(action,ecBadAction)
//Someday, may let non-standard action become the command!
cb>>CB.command = action % DCaS
//cb>>CB.command = (table
//[
//diskRead * (DCheaderx + DClabelx + DCdatax) + DCaS;
//diskCheck * DCheaderx + diskRead * (DClabelx + DCdatax) + DCaS;
//diskCheck * (DCheaderx + DClabelx) + diskRead * DCdatax + DCaS;
//diskWrite * (DCheaderx + DClabelx +DCdatax) + DCaS;
//diskCheck * DCheaderx + diskWrite * (DClabelx + DCdatax) + DCaS;
//diskCheck * (DCheaderx + DClabelx) + diskWrite * DCdatax + DCaS;
//msb rshift offset DC.seekOnly + DCaS
//])!actNumber
//if disk>>DSK.driveNumber then cb>>CB.command.exchangeDisks = 1
// QueueDiskCommand(cb)
DisableInterrupts()
SendCmmd:
let p = nil
let np = rv nextDiskCommand
if np ne 0 then
[
[ p = np; np = p>>CB.nextCommand ] repeatuntil np eq 0
p>>CB.nextCommand = cb
]
// If there are no disk commands queued at the moment, be very careful
// about plopping down a pointer to our cb. We must be sure that the
// previous cb for this zone has NOT encountered an error (it's OK
// if it is free or has been transferred already, but not OK if there
// is an error or if it has not been transferred at all)
if rv nextDiskCommand eq 0 then
[
let t = z!CBZqueueTail
if t eq (lv z>>CBZ.queueVec) then t = z>>CBZ.endQueueVec
let prevCb = t!-1
let stat = prevCb>>CB.status & DSTgoodStatusMask
if prevCb eq 0 then Bug()
if stat ne 0 & (stat & DSTerrorBits) eq 0 then
@nextDiskCommand = cb
]
EnableInterrupts()
p = NextCb(z, CBZqueueTail)
if @p ne 0 then Bug(); @p = cb
]
//---------------------------------------------------------------------------
and GetCb(zone, dontClear; numargs na) = valof
//---------------------------------------------------------------------------
[
let t = NextCb(zone, CBZqueueHead)
let cb = rv t; if cb eq 0 then Bug(); rv t = 0
LastCb = cb
let i = 0
[
if (cb>>CB.status & DSTdoneBits) ne 0 break
i=i+1
if i eq 0 then break //dont wait for ever ****
] repeat
if TP1 then [ cb>>CB.status = TP1; until @nextDiskCommand eq 0 loop ]
// remove seal
cb>>CB.command = cb>>CB.command & #377
//cb>>CB.status = cb>>CB.status & #177377//mask of bit #400 so it can be used for check err
let transfer = false //Flag true if cb was used in a transfer
// Various ways the cb can be found usable:
ErrCode:
[
// This is the test for errors
let s = cb>>CB.status & DSTgoodStatusMask
if s eq DSTfreeStatus break
unless cb>>CB.diskAddress.restore do transfer = true
if s eq DSTgoodStatus then break
// We should probably discriminate among the various kinds of error
// Wait for disk to stop spinning
until @nextDiskCommand eq 0 loop
let ec = zone>>CBZ.errorCount +1
zone>>CBZ.errorCount = ec
saveErr(zone>>CBZ.DAs+ cb>>CB.truePageNumber, s xor #400, ec)//**** DELETE for BFS.bcpl
if CheckInput() then ReturnTo(Aexit) // **** DELETE FOR TFS.bcpl
if ec ge maxEC then
[
// Unrecoverable error
//DO WHAT I WANT HERE
t=zone>>CBZ.cleanupRoutine
if t then if t(cb,false) then CheckData(cb,false)
ec = 0
cb>>CB.truePageNumber = cb>>CB.truePageNumber+1
zone>>CBZ.errorCount=0
]
let DA = cb>>CB.diskAddress
zone>>CBZ.errorDA = DA
if cb>>CB.status.finalStatus eq dsCheckError then
zone>>CBZ.checkError = true
// Now rebuild the zone:
InitializeCbStorage(zone, cb>>CB.truePageNumber)
// If the error count is large enough, initiate a restore. Note
// that the command is issued, but we do not wait to be sure
// it completes.
if ec gr ErrRes then DoDiskCommand(GetCb(zone), 0, DA, 0, 0, BFSrestoreAndSeek)
ReturnTo(zone>>CBZ.retry)
] repeat
if transfer then
[
t = zone>>CBZ.cleanupRoutine
if t then if t(cb, true) do [ cb>>CB.status.CompairErr = 0; goto ErrCode ]
zone>>CBZ.currentNumChars = cb>>CB.labelAddress>>DL.numChars
zone>>CBZ.errorCount = 0
]
unless na ge 3 & dontClear do Zero(cb, lVarCB)
resultis cb
]
//---------------------------------------------------------------------------
and Bug() be SysErr(nil,ecBfsBug)
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
and ActOnPages(CAs, DAs, fp, firstPage, lastPage, action,
lvNumChars, lastAction, fixedCA, cleanupRoutine; numargs na) = valof
//---------------------------------------------------------------------------
[
//let GetNextDA(cb) be
//[
//let t = lv ((cb>>CB.zone>>CBZ.DAs)!(cb>>CB.truePageNumber))
//if t!1 eq fillInDA then
//t!1 = VirtualDA(lv cb>>CB.labelAddress>>DL.next)
//if t!(-1) eq fillInDA then
//t!(-1)=VirtualDA(lv cb>>CB.labelAddress>>DL.previous)
//]
let dummy = nil
let reslt = nil
DefaultArgs(lv na, -6, lv dummy, action, 0 ,0)
let zone = vec CBzoneLength
InitializeCbStorage(zone, firstPage, CBzoneLength, Aretry)
zone>>CBZ.DAs = DAs
zone>>CBZ.cleanupRoutine = cleanupRoutine
Aretry:
[
// Note that each cb is used twice: to hold the DL for
// page i-1, and then to hold the 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 sequentially by
// page number.
// Note: Inside this loop, there may be disk commands pending
// (i.e. pointed to by nextDiskCommand). DoDiskCommand
// initiates them (also GetCb may initiate a restore). Hence
// do not simply "return" from inside the loop unless you are
// absolutely sure that no disk activity is queued.
Aexit = AexitLabel
let cb = GetCb(zone)
reslt = lastPage
for i = zone>>CBZ.currentPage to lastPage do
[
let a = action; if i eq lastPage then a = lastAction
if a<<DC.headerAction eq diskSkip then loop
if DAs!0 eq eofDA then [ reslt = i-1; break ]
let nextCb = GetCb(zone)
//cb>>CB.labelAddress=((DAs!(i+1) eq fillInDA)?
//lv nextCb>>CB.diskAddress,lv nextCb>>CB.label)
let Wbuff = WhereIsWbuff(i)
cb>>CB.labelAddress = lv cb>>CB.label
test PattCnt eq 2 //check to see what type of pattern is being tested
ifso MoveBlock(cb>>CB.labelAddress,Wbuff+8,8) //Random data
ifnot MoveBlock(cb>>CB.labelAddress,Wbuff,8) //Other Pattern
if action<<DC.dataAction eq diskCheck then cb>>CB.dataAddress = Wbuff
DoDiskCommand(cb, (CAs eq 0 ? fixedCA, CAs!i),DAs!i, fp, i, a)
cb = nextCb
]
while @zone>>CBZ.queueHead ne 0 do GetCb(zone)
]
@lvNumChars = zone>>CBZ.currentNumChars
resultis reslt
AexitLabel: //*** DELETE FOR TFS
resultis LastCb>>CB.truePageNumber
]