// VMemSpyCore.bcpl
// Copyright Xerox Corporation 1980
// Last modified December 28, 1980  6:31 PM by Boggs

get "Pup0.decl"
get "Pup1.decl"
get "Streams.d"
get "AltoDefs.d"
get "IfsRs.decl"
get "VMem.d"
get "IfsVMem.decl"
get "IfsVMemSpy.decl"
get "VMemSpy.decl"

external
[
// outgoing procedures
Spy

// incoming procedures
Puts; Resets; Endofs; PutTemplate; Wss
SetBitPos; EraseBits; CharWidth
CallSwat; MoveBlock; Dequeue; MultEq

Block; SetTimer; TimerHasExpired

OpenLevel1Socket; CloseLevel1Socket
GetPBI; CompletePup; ReleasePBI; FlushQueue

// incoming statics
dt; nt; port; show; noshow; keys; dsp
]

//----------------------------------------------------------------------------
let Spy() be
//----------------------------------------------------------------------------
[
port>>Port.socket↑1 = 1
port>>Port.socket↑2 = socketVMemSpy
let spySoc = vec lenPupSoc
OpenLevel1Socket(spySoc, 0, port)
let oldStats = vec lenVMStats
while Endofs(keys) do
   [  // main program loop
   let pbi, timer = nil, nil
   if spySoc>>PupSoc.iQ.head eq 0 then
      [  // send a probe
         [
         pbi = GetPBI(spySoc, true)
         if pbi ne 0 break
         FlushQueue(lv spySoc>>PupSoc.iQ)
         Block()
         ] repeat
      CompletePup(pbi, typeVMemSpyRequest, pupOvBytes)
      SetTimer(lv timer, 100)  //1 second
      ]

   // wait for an answer
   Block() repeatuntil TimerHasExpired(lv timer) % spySoc>>PupSoc.iQ.head ne 0
   pbi = Dequeue(lv spySoc>>PupSoc.iQ); if pbi eq 0 loop  //timed out

   if pbi>>PBI.pup.type eq typeVMemSpyReply then
      [
      for i = 0 to 15 do cursorBitMap!i = not cursorBitMap!i
      let vms = lv pbi>>PBI.pup.words
      // All loops go from 1 to 63, ignoring real page 0 since it is
      //  special in many ways and we know it can't be a vMem buffer.

      let numPages = 0
      for rPage = 1 to 63 if vms>>VMS.type↑rPage ne 0 then
         numPages = numPages +1
      if numPages gr maxLines then CallSwat("Increase maxLines")
      for line = 1 to maxLines do dt>>DT↑line.address = 0
      let line = (maxLines-numPages)/2
      for rPage = 1 to 63 if vms>>VMS.type↑rPage ne 0 then
         [
         dt>>DT↑line.address = rPage
         line = line +1
         ]

// Spy (cont'd)

      for rPage = 1 to 63 do
         [
         let line = 0
         for j = 1 to maxLines do
            if dt>>DT↑j.address eq rPage then
               [ line = j; break ]
         if line eq 0 loop

         dt>>DT↑line.vPage = vms>>VMS.vPage↑rPage
         dt>>DT↑line.dirty = vms>>VMS.dirty↑rPage ne 0
         dt>>DT↑line.locked = vms>>VMS.locked↑rPage ne 0

         switchon vms>>VMS.type↑rPage into
            [
            case 0: endcase  //not a VM buffer
            case vmiTypeOverlay:
               [
               dt>>DT↑line.name = nt!(vms>>VMS.ovNum↑rPage)
               endcase
               ]
            case vmiTypeVFile:
               [
               dt>>DT↑line.name = "VFile"
               endcase
               ]
            case vmiTypeDD:
               [
               dt>>DT↑line.name = "DiskDescriptor"
               endcase
               ]
            case vmiTypeLeaf:
               [
               dt>>DT↑line.name = "Leaf"
               endcase
               ]
            case maxVMIType+1:  //snarfed
               [
               dt>>DT↑line.locked = true
               dt>>DT↑line.vPage = 0
               dt>>DT↑line.name = selecton vms>>VMS.jobType↑rPage -1 into
                  [
                  case jobTypeFTP: "FTP job"
                  case jobTypeMTP: "MTP job"
                  case jobTypeTelnet: "Telnet job"
                  case jobTypeBackup: "Backup job"
                  case jobTypeMail: "Mail job"
                  case jobTypeMiscellaneous: "MiscServ job"
                  case jobTypeLeaf: "Leaf job"
                  case jobTypePress: "Press job"
                  case jobTypeNameUpdate: "NameUpdate job"
                  case jobTypeBootUpdate: "BootUpdate job"
                  case jobTypeCopyDisk: "CopyDisk job"
                  default: "Snarfed"
                  ]
               endcase
               ]
            case maxVMIType+2:  // free page
               [
               dt>>DT↑line.name = "Free page"
               dt>>DT↑line.vPage = 0
               endcase
               ]
            default:
               [
               dt>>DT↑line.name = "[Unknown page type]"
               endcase
               ]
            ]
         ]

// Spy (cont'd)

      for line = 1 to maxLines do
         [
         let ds = dt>>DT↑line.ds

         // address
         if dt>>DT↑line.lastAddress ne dt>>DT↑line.address then
            [
            dt>>DT↑line.lastAddress = dt>>DT↑line.address
            Resets(ds)
            dt>>DT↑line.lastLocked = false
            if dt>>DT↑line.address eq 0 loop
            SetBitPos(ds, posAddress)
            PutTemplate(ds, "$6UO", dt>>DT↑line.address lshift 10)
            SetBitPos(ds, posLBorder)
            EraseBits(ds, widthBorder, 1)  //left
            SetBitPos(ds, posRBorder)
            EraseBits(ds, widthBorder, 1)  //right
            ]
         if dt>>DT↑line.address eq 0 loop

         // vPage
         if dt>>DT↑line.lastVPage ne dt>>DT↑line.vPage then
            [
            dt>>DT↑line.lastVPage = dt>>DT↑line.vPage
            SetBitPos(ds, posVPage)
            EraseBits(ds, widthVPage, 0)
            if dt>>DT↑line.vPage ne 0 then
               [
               SetBitPos(ds, posVPage)
               PutTemplate(ds, "$6UO", dt>>DT↑line.vPage)
               ]
            if dt>>DT↑line.lastLocked then
               [
               SetBitPos(ds, posVPage)
               EraseBits(ds, widthVPage, -1)
               ]
            ]

         // name
         if dt>>DT↑line.lastName ne dt>>DT↑line.name then
            [
            dt>>DT↑line.lastName = dt>>DT↑line.name
            SetBitPos(ds, posName)
            EraseBits(ds, widthName, 0)
            if dt>>DT↑line.name ne 0 then
               [
               SetBitPos(ds, posName)
               Wss(ds, dt>>DT↑line.name)
               ]
            if dt>>DT↑line.lastLocked then
               [
               SetBitPos(ds, posName)
               EraseBits(ds, widthName, -1)
               ]
            ]
      
      // Spy (cont'd)

         // dirty
         if dt>>DT↑line.lastDirty ne dt>>DT↑line.dirty then
            [
            dt>>DT↑line.lastDirty = dt>>DT↑line.dirty
            SetBitPos(ds, posDirty)
            test dt>>DT↑line.dirty
               ifso Puts(ds, $*377)  //mark dirty
               ifnot EraseBits(ds, 16, (dt>>DT↑line.lastLocked? 1, 0))
            ]

         // Background
         if dt>>DT↑line.lastLocked ne dt>>DT↑line.locked then
            [
            dt>>DT↑line.lastLocked = dt>>DT↑line.locked
            SetBitPos(ds, posDirty)
            EraseBits(ds, posRBorder-posDirty, -1)
            ]
         ]

      // process vmem stats
      let vmStats = lv vms>>VMS.stats
      unless MultEq(oldStats, vmStats, lenVMStats) do
         [
         Resets(noshow)
         Wss(noshow, "VMem    Overlay    VFile       DD     Leaf")
         Wss(noshow, "*NReads ")
         for type = 1 to maxVMIType do
            PutTemplate(noshow, "$9ED", lv vmStats>>VMStats.reads↑type)
         Wss(noshow, "*NWrites")
         for type = 1 to maxVMIType do
            PutTemplate(noshow, "$9ED", lv vmStats>>VMStats.writes↑type)
         let p = lv vmStats>>VMStats.ovXMReads
         if p!0 ne 0 % p!1 ne 0 then
            PutTemplate(noshow, "*N$ED overlay reads from XM, $ED from disk",
             lv vmStats>>VMStats.ovXMReads, lv vmStats>>VMStats.ovDiskReads)
         dt>>DT↑1.ds>>DS.ldcb>>DCB.next = noshow>>DS.fdcb
         let temp = show; show = noshow; noshow = temp
         MoveBlock(oldStats, vmStats, lenVMStats)
         ]
      ]

   ReleasePBI(pbi)
   ]

CloseLevel1Socket(spySoc)
]