// SwatSpyB.bcpl  Spy module -- for metering programs
// Copyright Xerox Corporation 1979, 1981, 1982
// Last modified May 6, 1982  2:14 PM by Taft

get "Swat.decl"
get "AltoDefs.d"
get "Streams.d"
get "AltoFileSys.d"

external
[
// outgoing procedures
MeasureSpy; StartSpy; DisplaySpy; StopSpy

// incoming procedures from Swat
VMFetch; VMStore; Mul; Div
MapSym; AddrToSym; StaticValue; SymBank; ReadSymsFile; SymReset
ReadString; Confirm; ReportFail

// incoming procedures from OS
Allocate; Free; Noop; MoveBlock
OpenFile; CreateDiskStream; Closes; Puts
ReadDiskDescriptor; WriteDiskDescriptor
PutTemplate; Ws; Wss; Umax

// incoming statics
sysZone; dsp
spyCode; spyCodeEnd
cfaSym; symFileName; xmFlag
]

static
[
spying; spyInterrupt; k; amax
nCounts; ranges; counts
tempR; tempC; tempFN; tempCFA
]

// Range table in user memory looks like
// 	0		//low guard
//	xx
//	xx		//procedure addresses sorted by address
//	yy		//higest procedure
//	yy+100		//to try to capture highest procedure
//	-1		//high guard

//----------------------------------------------------------------------------
let MeasureSpy() be
//----------------------------------------------------------------------------
   PutTemplate(dsp, "I need $OB words of your memory.*n",
    spyCodeEnd-spyCode+2*NumOfEntrys())

//----------------------------------------------------------------------------
and NumOfEntrys() = valof
//----------------------------------------------------------------------------
[
nCounts = 3
let tally(nil) be nCounts = nCounts +1
MapSym(tally, tally, Noop)
resultis nCounts
]

//----------------------------------------------------------------------------
and StopSpy() be if spying then
//----------------------------------------------------------------------------
[
unless spying return
VMStore(activeInterrupts, VMFetch(activeInterrupts) & not(1 lshift spyInterrupt))
VMStore(displayInterrupt, VMFetch(displayInterrupt) & not(1 lshift spyInterrupt))
spying = false
Ws("Spying stopped.*N")
]

//----------------------------------------------------------------------------
and StartSpy(spyArea) be
//----------------------------------------------------------------------------
// spyArea is address of space donated to spy by user.
[
if spying then ReportFail("Already spying")
unless Confirm("Confirm my use of $UO for spy table: ", spyArea) return

// These constants define where bcpl patches SpyCode
// They must match SwatSpyA.asm
manifest
   [
   bRanges = 0		//beginning of ranges
   eRanges = 1		//end of ranges +1
   delta = 2		//counts-bRanges
   ipt = 3		//interrupts per tally
   itnt = 4		//interrupts till next tally
   start = 5		//starting address of interrupt code
   ]

// Create tables
nCounts = NumOfEntrys()
ranges = spyArea + spyCodeEnd - spyCode
counts = ranges + nCounts

// Set up the spy code in user space
spyCode!bRanges = ranges
spyCode!eRanges = ranges + nCounts
spyCode!delta = counts - ranges
spyCode!ipt = 1
spyCode!itnt = 1
for i = 0 to spyCodeEnd-spyCode-1 do VMStore(spyArea+i, spyCode!i)

// Set up the spy tables in swatee space
k, amax = 0, 0
MapSym(StoreEnt, StoreEnt, Noop)
GetSpace()  // moves tables to Swat space and destroys symbol table!
for i = 0 to nCounts-1 do tempC!i = 0
tempR!(nCounts-3) = amax+100  //guess length
tempR!(nCounts-2) = -1  //high guard
tempR!(nCounts-1) = 0  //low guard
SpySort(true)  //Sort by range
ReleaseSpace()  // moves tables back to swatee space

// Set up an interrupt channel
spyInterrupt = 1
   [
   if (VMFetch(activeInterrupts) & (1 lshift spyInterrupt)) eq 0 break
   if spyInterrupt ge 14 then ReportFail("No interrupts left")
   spyInterrupt = spyInterrupt +1
   ] repeat
VMStore(interruptVector+spyInterrupt, spyArea+start)
VMStore(activeInterrupts, VMFetch(activeInterrupts) % (1 lshift spyInterrupt))
VMStore(displayInterrupt, VMFetch(displayInterrupt) % (1 lshift spyInterrupt))
spying = true
]

//----------------------------------------------------------------------------
and StoreEnt(sym) be
//----------------------------------------------------------------------------
[
let a = StaticValue(sym, false)
if xmFlag then [ a = SymBank(sym) lshift 14 + a rshift 2 ]
VMStore(ranges+k, a)
k = k +1
amax = Umax(amax, a)
]

//----------------------------------------------------------------------------
and DisplaySpy(stopSpying) be
//----------------------------------------------------------------------------
[
unless spying do ReportFail("Not spying")

GetSpace()
let i, total = 0, 0; while i ls nCounts-1 do  // Scale counts
   [
   let count = tempC!i
   i, total = i+1, total+count
   if total uge 100000b % count uge 100000b then
      [
      for j = 0 to nCounts-1 do tempC!j = tempC!j rshift 1
      i, total = 0, 0
      ]
   ]
if total eq 0 then
   [ ReleaseSpace(); ReportFail("Spyee hasn't run long enough") ]

// Get output stream settled
let name = ReadString("File? (CR to display): ")
if name then ReadDiskDescriptor()
let stream = name? OpenFile(name, ksTypeWriteOnly, charItem), dsp 
if name then Free(sysZone, name)

SpySort(false)  //Sort by counts
ReleaseSpace()

// Compute and print percentages
PutTemplate(stream, "Out of a total of $D tallies...*N", total)
let noLine, highRange = 0, VMFetch(ranges+nCounts-2)
for i = 0 to nCounts-1 do
   [
   let range, count = VMFetch(ranges+i), VMFetch(counts+i)
   let dividend, remainder = vec 1, nil
   Mul(0, count, 1000, lv dividend)
   let quotient = Div(lv dividend, total, lv remainder)
   if remainder uge total rshift 1 then quotient = quotient +1
   if quotient eq 0 then [ Wss(stream, "*nAll others zero.*n"); break ]

   test noLine eq 4
      ifso [ Puts(stream, $*N); noLine = 1 ]
      ifnot noLine = noLine +1
   test range eq 0
      ifso Wss(stream, "Low range")
      ifnot test range eq highRange
         ifso Wss(stream, "High range")
         ifnot test xmFlag
            ifso AddrToSym(stream, range lshift 2 +3, range rshift 14, 3)
            ifnot AddrToSym(stream, range)
   PutTemplate(stream, ": $D.$D%  ", quotient/10, quotient rem 10)
   ]

Puts(stream, $*N)
if name then [ Closes(stream); WriteDiskDescriptor() ]

test stopSpying
   ifso StopSpy()
   ifnot
      [
      GetSpace()
      SpySort(true)
      ReleaseSpace()
      ]
]

//----------------------------------------------------------------------------
and SpySort(byRange) be
//----------------------------------------------------------------------------
[
let l, r = nCounts rshift 1, nCounts-1
   [
   let range, count = nil, nil
   test l gr 0
      ifso
         [
         l = l -1
         range = tempR!l
         count = tempC!l
         ]
      ifnot
         [
         range = tempR!r; tempR!r = tempR!0
         count = tempC!r; tempC!r = tempC!0
         r = r -1
         if r eq 0 then
            [
            tempR!0 = range
            tempC!0 = count
            break  //all done
            ]
         ]
   let j, i = l, nil
      [
      i = j
      j = j lshift 1 +1
      if j gr r break
      if j ls r test byRange
         ifso if tempR!j uls tempR!(j+1) then j = j+1
         ifnot if tempC!j uge tempC!(j+1) then j = j+1
      test byRange
         ifso if tempR!j uls range break
         ifnot if tempC!j uge count break
      tempR!i = tempR!j
      tempC!i = tempC!j
      ] repeat
   tempR!i = range
   tempC!i = count
   ] repeat
]

//----------------------------------------------------------------------------
and GetSpace() be
//----------------------------------------------------------------------------
[
tempFN = symFileName; symFileName = 0
if tempCFA eq 0 then tempCFA = Allocate(sysZone, lCFA)
MoveBlock(tempCFA, cfaSym, lCFA)
SymReset()
tempC, tempR = Allocate(sysZone, nCounts), Allocate(sysZone, nCounts)
for i = 0 to nCounts-1 do
   [ tempR!i = VMFetch(ranges+i); tempC!i = VMFetch(counts+i) ]
]

//----------------------------------------------------------------------------
and ReleaseSpace() be
//----------------------------------------------------------------------------
[
for i = 0 to nCounts-1 do
   [ VMStore(ranges+i, tempR!i); VMStore(counts+i, tempC!i) ]
Free(sysZone, tempC); Free(sysZone, tempR)
if tempFN ne 0 then
   [
   let stream = CreateDiskStream(lv tempCFA>>CFA.fp, ksTypeReadOnly, wordItem)
   if stream then [ ReadSymsFile(stream, tempFN); Closes(stream) ]
   Free(sysZone, tempFN); tempFN = 0
   ]
]