// SwatDisk.bcpl - Disk stuff
// Copyright Xerox Corporation 1979, 1982
// Last modified March 21, 1982 11:25 PM by Boggs
get "Altodefs.d"
get "AltoFileSys.d"
get "Streams.d"
get "Disks.d"
get "Swat.decl"
get "SwatDisk.decl"
external
[
// outgoing procedures
CreateKVM
// incoming procedures
Disable; Enable
Fail; ReportFail; SetFailPt; UnSetFailPt
PutTemplate; Ws; Wss; Puts
Allocate; Free; Zero; SetBlock; MoveBlock
Enqueue; Dequeue; Unqueue; QueueLength
Idle; Noop; OutLd; InLd
OpenFile; Closes; WriteBlock
ActOnDiskPages; WriteDiskPages
DeleteDiskPages; RealDiskDA
ExtractSubstring
// incoming statics
sysDisk; sysZone; dsp; swattingOK; vm; fpSwat
]
//----------------------------------------------------------------------------
let CreateKVM(string, create; numargs na) = valof
//----------------------------------------------------------------------------
// FilePn: 0 1 2 ... 375b 376b 377b 400b
// Contents: leader loader user2 ... user375 user1 user0 empty
// 0 1 2 ... hsp hsp+1 hsp+2 hsp+3
[
if na ls 2 then create = false
let kvm = Allocate(sysZone, lenKVM); Zero(kvm, lenKVM)
kvm>>VM.name = string
SetBlock(lv kvm>>KVM.DAs, fillInDA, hsp+6)
SetFailPt(ckvm)
[
Zero(lv kvm>>KVM.fp, lFP)
let s = OpenFile(string, (create? ksTypeWriteOnly, ksTypeReadOnly),
wordItem, (create? verLatestCreate, verLatest), lv kvm>>KVM.fp)
if s eq 0 then ReportFail("File not found")
Closes(s)
kvm>>KVM.DAs↑0 = kvm>>KVM.fp.leaderVirtualDa
let fixedCA = vec 256
let numChars = nil
let DAs = lv kvm>>KVM.DAs↑0
let lastPage = ActOnDiskPages(sysDisk, 0, DAs, lv kvm>>KVM.fp, 0,
hsp+3, DCreadD, lv numChars, 0, fixedCA)
if lastPage ls hsp+3 test create
ifnot ReportFail("This file was not created by OutLd")
ifso
[
DAs!(lastPage+1) = fillInDA
WriteDiskPages(sysDisk, 0, DAs, lv kvm>>KVM.fp, lastPage,
hsp+3, DCwriteD, lv numChars, 0, fixedCA)
]
if create then
[
let leftoverDA = DAs!(hsp+4)
if numChars ne 0 then
WriteDiskPages(sysDisk, 0, DAs, lv kvm>>KVM.fp, hsp+3,
hsp+3, DCwriteD, 0, 0, fixedCA)
if leftoverDA ne eofDA then
DeleteDiskPages(sysDisk, fixedCA, leftoverDA, lv kvm>>KVM.fp, hsp+4)
]
RealDiskDA(sysDisk, DAs!1, lv kvm>>KVM.fp.leaderVirtualDa)
RealDiskDA(sysDisk, DAs!(hsp+2), DAs) // page 0
RealDiskDA(sysDisk, DAs!(hsp+1), DAs+1) // page 1
for i = 2 to hsp do RealDiskDA(sysDisk, DAs!i, DAs+i) // pages 2 to hsp
kvm>>VM.fetch = KVMFetch
kvm>>VM.store = KVMStore
kvm>>VM.swap = KVMSwap
kvm>>VM.cache = KVMCache
kvm>>VM.destroy = KVMDestroy
kvm>>VM.print = KVMPrint
kvm>>VM.type = vmTypeDisk
MoveBlock(cursorBitMap, table [ 100000b; 140000b; 160000b; 170000b;
174000b; 176000b; 177000b; 170000b; 154000b; 114000b; 006000b;
006000b; 003000b; 003000b; 001400b; 001400b ], 16)
UnSetFailPt()
resultis kvm
]
ckvm:
KVMDestroy(kvm)
Fail()
]
//----------------------------------------------------------------------------
and KVMDestroy(kvm) be
//----------------------------------------------------------------------------
[
KVMCache(kvm, vmFlushReset)
Free(sysZone, kvm>>VM.name)
Free(sysZone, kvm)
]
//----------------------------------------------------------------------------
and KVMSwap(kvm) be
//----------------------------------------------------------------------------
[
let scm = KVMFetch(kvm, 567b)
let fpSwatee = lv kvm>>KVM.fp
for i = 0 to lFP-1 do KVMStore(kvm, scm+swateeOffset+i, fpSwatee!i)
for i = 0 to lFP-1 do KVMStore(kvm, scm+swatOffset+i, fpSwat!i)
KVMCache(kvm, vmFlushReset)
Disable()
unless OutLd(fpSwat, 0) do InLd(fpSwatee, 0)
Enable()
KVMCache(kvm, vmReset)
]
//----------------------------------------------------------------------------
and KVMCache(kvm, action) be
//----------------------------------------------------------------------------
[
let kb = kvm>>KVM.kbQ.head; while kb ne 0 do
[
let nextKB = kb>>KB.link
if (action & vmFlush) ne 0 & kb>>KB.dirty ne 0 then
RWDiskPage(kvm, kb, kb>>KB.userPage, writeD, true)
if (action & vmReset) ne 0 then
[ Unqueue(lv kvm>>KVM.kbQ, kb); Free(sysZone, kb) ]
kb = nextKB
]
]
//----------------------------------------------------------------------------
and KVMPrint(kvm, stream) be
//----------------------------------------------------------------------------
[
PutTemplate(stream, ", hits: $UD misses: $UD*N*N",
kvm>>KVM.hits, kvm>>KVM.misses)
Wss(stream, "Core addr = Disk addr*N")
let kb = kvm>>KVM.kbQ.head; while kb ne 0 do
[
PutTemplate(stream, " $U6O = $UO*N",
kb>>KB.userPage lshift 8, kb>>KB.address)
kb = kb>>KB.link
]
]
//----------------------------------------------------------------------------
and KVMFetch(kvm, addr) = @RealAddr(kvm, addr, false)
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and KVMStore(kvm, addr, val) be @RealAddr(kvm, addr, true) = val
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and RealAddr(kvm, addr, makeDirty) = valof
//----------------------------------------------------------------------------
[
let userPage = addr rshift 8
if userPage gr hsp resultis addr // I/O region not swapped
let userWord = addr & 377b
let kbQ = lv kvm>>KVM.kbQ
// search cache
let kb = kbQ!0; while kb ne 0 do
[
if kb>>KB.userPage eq userPage break
kb = kb>>KB.link
]
test kb ne 0
ifso [ Unqueue(kbQ, kb); kvm>>KVM.hits = kvm>>KVM.hits +1 ]
ifnot //miss
[
kvm>>KVM.misses = kvm>>KVM.misses +1
let lenKBQ = QueueLength(kbQ)
if lenKBQ ls maxKBs then
kb = Allocate(sysZone, lenKB, lenKBQ ne 0)
if kb eq 0 then
[
kb = Dequeue(kbQ)
if kb>>KB.dirty ne 0 then
RWDiskPage(kvm, kb, kb>>KB.userPage, writeD, true)
]
RWDiskPage(kvm, kb, userPage, readD, true)
]
Enqueue(kbQ, kb)
if makeDirty then kb>>KB.dirty = true
resultis lv kb>>KB.dataRec + userWord
]
//----------------------------------------------------------------------------
and FilePage(upn) = upn eq 0? hsp+2, upn eq 1? hsp+1, upn eq -1? 1, upn
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and UserPage(fpn) = fpn eq hsp+2? 0, fpn eq hsp+1? 1, fpn eq 1? -1, fpn
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and RWDiskPage(kvm, kb, userPage, command, retryErrors) be
//----------------------------------------------------------------------------
[
for trys = 1 to 10 do
[
if trys gr 4 then RWDiskPage(kvm, kb, userPage, restore, false)
Zero(kb+1, offset KB.dataRec/16-1)
kb>>KB.userPage = userPage
kb>>KB.command = command
if command eq restore then @diskAddress = -1
kb>>KB.header = lv kb>>KB.headerRec
kb>>KB.label = lv kb>>KB.labelRec
kb>>KB.data = lv kb>>KB.dataRec
kb>>KB.address = command eq restore? 1, kvm>>KVM.DAs↑userPage
kb>>KB.numChars = 512
kb>>KB.filePage = FilePage(userPage)
kb>>KB.vn = kvm>>KVM.fp.version
kb>>KB.sn1 = kvm>>KVM.fp.serialNumber.word1
kb>>KB.sn2 = kvm>>KVM.fp.serialNumber.word2
@diskCommand = lv kb>>KB.kcb
until kb>>KB.status ne 0 do Idle()
unless retryErrors return
switchon kb>>KB.status & 377b into
[
case 0: return // good status
case 2: break // check error
default: loop // other error
]
]
Ws("*N*NDisk error in Swatee*N")
PutTemplate(dsp, "Status: $UO, Command: $UO, Disk Address: $UO*N",
kb>>KB.status, kb>>KB.command, kb>>KB.address)
PrintLabel("Label for Swatee:", kb)
let s = kb>>KB.status
test (s&3) eq 2
ifso
[
RWDiskPage(kvm, kb, userPage, readHLD, false)
PrintLabel("Label from disk: ", kb)
Ws("Check error*N")
]
ifnot
[
if (s & 200b) ne 0 then Ws("Seek failed ")
if (s & 100b) ne 0 then Ws("Seek in progress ")
if (s & 40b) ne 0 then Ws("Disk not ready (on?) ")
if (s & 20b) ne 0 then Ws("Processing late ")
if (s & 10b) ne 0 then Ws("No data transferred ")
if (s & 4b) ne 0 then Ws("Checksum error ")
Puts(dsp, $*N)
]
Free(sysZone, kb)
Fail()
]
//----------------------------------------------------------------------------
and PrintLabel(text, kb) be
//----------------------------------------------------------------------------
[
PutTemplate(dsp, "$S nextP backP numCh page serial vers*N", text)
for i = 1 to text>>String.length-1 do Puts(dsp, $*S)
PutTemplate(dsp, " $U6F0O $U6F0O $U6F0O $U6F0O $EU11F0O $U6F0O*N",
kb>>KB.backP, kb>>KB.nextP, kb>>KB.numChars, kb>>KB.filePage,
lv kb>>KB.sn1, kb>>KB.vn)
]