// SwatSpyB.bcpl Spy module -- for metering programs
// Copyright Xerox Corporation 1979, 1981, 1982, 1983
// Last modified October 12, 1983 11:22 AM 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
xmEnabled = 6 //copy of xmFlag
]
// 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
spyCode!xmEnabled = xmFlag
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
]
]