// 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)
]