// RaidProcs.bcpl. Supplementary procedures for RAID
// Last modified September 19, 1981 2:01 PM by Bill van Melle
// Last modified August 4, 1981 12:47 PM by Beau Sheil
// Last modified March 16, 1981 12:56 PM by Beau Sheil
// Last modified July 27, 1980 6:56 PM by Beau Sheil
// Last modified May 27, 1980 4:36 PM by Beau Sheil

get "AltoDefs.d"
get "Raid.decl"
get "Pup0.decl"
get "Pup1.decl"
get "Stats.decl"
get "Streams.d"

external [ // defined here
AtomNum; ShowRealCore; TeleRaid; uPCTracing; @uPCTraceAddr
DisplayVMinBitMap; DisplayVMbit; VMDisplay
]

external [ // procedures used
Zero; VirtualPage; CallSwat; CRLF; Ws; Wo; Bytes2
StealFromBcplDisplay; AddToBcplDisplay; DumpBlockToStats
RaidReset; UPCTrace; ShowDisplayStream
@BGetBase; @BGetBasePtr; @XPutBase; @XSetBR; @RRead; @RWrite
Dequeue; MoveWords; CompletePup; ExchangePorts; ReleasePBI
SetTimer; TimerHasExpired; EmAddr; Block
// statics used
EmulatorSpace; LastRealPageNo; @lvVPtr
dsp; @DisplayAddrHi
]

static [
VMDisplay = 0
@uPCTraceAddr = 0
]

manifest [ LastSegment = 63// 22-bit address space
IMSize = #20000; DummyHeight = 32
VMbitMapOffset = 2+2*lDCB// bitmap within VMDisplay
VMDisplayWidth = 16; VMDisplayHeight = LastSegment+1
VMDisplayScanLines = DummyHeight + VMDisplayHeight
VMDisplaySize = VMbitMapOffset + VMDisplayWidth*VMDisplayHeight
TRRead = #201// teleRaid constants
TRHereIsPage = #301
TRStore = #200
TRStoreDone = #300
TRGo = #202
TRGoAck = #302
TRGoReply = #203
TRShow = #210
TRShown = #310
TRError = #304
]

let AtomNum(S) = valof
// Finds atom number for BCPL string. pn char format is that of bcpl strings
[
let LEN = S>>String.length
let NW = LEN rshift 1

// Compute the hash code for the name. Mimic the behavior of LISP
let SS = 0
for i = 1 to LEN do
[ let h1 = ((SS & #7777) lshift 2) + SS
SS = (h1 lshift 8) + h1 + S>>String.char↑i
]

[
let H = ((SS𒿑) rem (AHTSIZE lshift 8)) + AHTbase

// H is the virtual address in the AtomHashTable
let P = BGetBase(AHTspace, H)// P is address of hash table entry
if P eq 0 then RaidReset("No such atom")

// since P was non zero, it is the virtual address of an atom+1
P = P-1

// fetch atom and check its pname. Check its characters (word-by-word)
// with those in pname. Count is first byte, and pad byte (if any) is 0.
XSetBR(BGetBasePtr(PNPspace, PNPbase+(P lshift 1)))
for i = 0 to NW do if RRead(i) ne S!i goto reprobe

resultis P// pnames are the same; return virtual address

reprobe: SS = SS+HashInc
] repeat// comparison failed so reprobe
]

and ShowRealCore() be// Displays a segment page usage map
[
let base = vec LastSegment+2; Zero(base, LastSegment+3)
for i = 0 to LastRealPageNo-1-PagesPerSegment do
[ let bucket = VirtualPage(i)<<VP.segment
base!bucket = base!bucket + 1
]
base!EmulatorSpace = PagesPerSegment// Emulator done specially
Ws(" Segment Pages Contents*N")
let total = 0
for i = 0 to LastSegment do unless base!i eq 0
do [ Ws(" "); Wo(i); Ws(" "); Wo(base!i)
// The following is not a SELECT as the choices are not exclusive
if i ge MDSLo & i le MDSHi then Ws(" Main data space")
if i eq PNPspace then Ws(" PName pointers")
if i eq DEFspace then Ws(" Definitions")
if i eq TOPVALspace then Ws(" TopVals")
if i eq PLISTspace then Ws(" Property lists")
if i eq AHTspace then Ws(" Atom Hash Table")
if i eq PMTspace then Ws(" Primary Page Map (PMT)")
if i eq PAGEMAPspace then Ws(" Secondary Page Map")
if i eq INTERFACEspace then Ws(" Interface page")
if i eq MDSTYPEspace then Ws(" MDS type table")
if i eq STATSspace then Ws(" Statistics")
if i eq STACKspace then Ws(" Stack")
if i eq EmulatorSpace then Ws(" Alto emulator")
if i eq DisplayAddrHi & DisplayAddrHi ne 0
then Ws(" Lisp display bitmap")
if i ge PncLo & i le PncHi then Ws(" PName characters")
if i ge ArrayLo & i le ArrayHi then Ws(" Arrays and strings")
if i eq GCMainspace then Ws(" GC main table")
if i eq GCCollspace then Ws(" GC collision table")
CRLF()
total = total + base!i ]
Ws(" Total "); Wo(total); CRLF()
let sp = " "
Ws(sp); Wo(base!(LastSegment+1)); Ws(" Empty"); CRLF()
Ws(sp); Wo(base!(LastSegment+2)); Ws(" Unavailable"); CRLF()
Ws(sp); Wo(LastRealPageNo); Ws(" Total pages"); CRLF()
]

and TeleRaid(s) = valof
[
Block()// let inbound packets in
let pb = Dequeue(lv s>>PupSoc.iQ)
unless pb do resultis 0
let pup = lv pb>>PBI.pup
// let lastid = 0// cache low order bits of id
// test lastid eq pup>>Pup.id↑2
// ifso [ ReleasePBI(pb); resultis 0 ]// duplicate suppression
// ifnot [ lastid = pup>>Pup.id↑2 ]
switchon pup>>Pup.type into
[ case TRRead: [ TellUser("Read")// ID is virtual addr of desired page
MoveWords(lv pup>>Pup.id↑1, EmAddr(lv pup>>Pup.words↑1),
WordsPerPage)
ExchangePorts(pb)
CompletePup(pb, TRHereIsPage, WordsPerPage lshift 1 + pupOvBytes)
endcase
]
case TRStore: [ TellUser("Store")// First two words are VA, third word is value to store
XPutBase(lv pup>>Pup.words↑1, pup>>Pup.words↑3)
ExchangePorts(pb)
CompletePup(pb, TRStoreDone, pupOvBytes)
endcase
]
case TRGo: [ TellUser("Go")
ExchangePorts(pb)
CompletePup(pb, TRGoAck, pupOvBytes)
let Timer = nil
SetTimer(lv Timer, 1000)// 10 sec timeout
[ pb = Dequeue(lv s>>PupSoc.iQ)
if pb % TimerHasExpired(lv Timer) then break
Block() ] repeat
test pb & (pb>>PBI.pup.type eq TRGoReply)
ifso [ // ↑N = go!
ReleasePBI(pb)
resultis #16 ]
ifnot [ TellUser("Go abort")
if pb then [ ExchangePorts(pb)
CompletePup(pb, TRError, pupOvBytes) ] ]
endcase
]
case TRShow: [ // Body is a bcpl string to print
Ws(lv pup>>Pup.bytes↑1)
ExchangePorts(pb)
CompletePup(pb, TRShown, pupOvBytes)
endcase
]
default: [ TellUser("Error")
ExchangePorts(pb)
CompletePup(pb, TRError, 0)
]
]
resultis 0
]

and TellUser(s) be [ Ws("["); Ws(s); Ws("]") ]

and uPCTracing(flg) be
[
test uPCTraceAddr eq 0
ifso [// turn tracing on
uPCTraceAddr = StealFromBcplDisplay(IMSize, 0)
UPCTrace(uPCTraceAddr)
]
ifnot [// turn tracing off and dump to lisp.stats
UPCTrace(0)
DumpBlockToStats(uPCevent, uPCTraceAddr, IMSize/128, 128)
if flg then AddToBcplDisplay(uPCTraceAddr, IMSize, 0)
uPCTraceAddr = 0
]
]

and DisplayVMinBitMap() be
[
if VMDisplay then
[ VMDisplay = 0
AddToBcplDisplay(VMDisplay, VMDisplaySize, VMDisplayScanLines)
return
]

VMDisplay = StealFromBcplDisplay(VMDisplaySize, VMDisplayScanLines)

let VMDisplayDCB = VMDisplay + 2
// insert a null dcb DummyHeight/2 scan lines high first
VMDisplay>>DS.fdcb = VMDisplayDCB
VMDisplayDCB>>DCB.next = VMDisplayDCB + lDCB
VMDisplayDCB>>DCB.width = 0
VMDisplayDCB>>DCB.bitmap = 0
VMDisplayDCB>>DCB.height = DummyHeight/2

VMDisplayDCB = VMDisplayDCB + lDCB
VMDisplay>>DS.ldcb = VMDisplayDCB
VMDisplayDCB>>DCB.next = 0
VMDisplayDCB>>DCB.height = VMDisplayHeight/2
VMDisplayDCB>>DCB.indentation = 1
VMDisplayDCB>>DCB.width = VMDisplayWidth
VMDisplayDCB>>DCB.bitmap = VMDisplay + VMbitMapOffset

// Turn on bits for pages already in core. Emulator done specially.
for i=0 to PagesPerSegment-1 do DisplayVMbit(Bytes2(EmulatorSpace,i), true)
for i=0 to LastRealPageNo-1-PagesPerSegment do
[ let vp = VirtualPage(i)
unless vp<<VP.segment gr LastSegment do DisplayVMbit(vp, true)
]
ShowDisplayStream(VMDisplay, DSabove, dsp)
]

and DisplayVMbit(vp, turnOnBit) be
[
// segement selects row; hi order 4 bits address word; lo order 4 get bit
let bitInWord = #100000 rshift (vp<<VP.page & #17)
let Addr = VMDisplay + VMbitMapOffset + (vp<<VP.segment*VMDisplayWidth) +
vp<<VP.page rshift 4
@Addr = turnOnBit ? @Addr % bitInWord, @Addr & not bitInWord
]