// RaidProcs.bcpl. Supplementary procedures for RAID
// Flushed TeleRaid July 20, 1983 2:49 PM by Bill van Melle
// Last modified March 30, 1983 11:31 AM by Bill van Melle
// Last modified December 16, 1982 10:15 PM by Bill van Melle
// Last modified July 21, 1982 9:32 PM by Bill van Melle
// Last modified September 19, 1981 2:01 PM by Bill van Melle
// Last modified August 4, 1981 12:47 PM by Beau Sheil

get "AltoDefs.d"
get "Raid.decl"
get "Stats.decl"
get "Vmem.decl"
get "Streams.d"

external [// procedures defined here
ReadNum; ReadAtom; AtomNum; ShowRealCore
DisplayVMinBitMap; DisplayVMbit; DoYankDef
// statics
VMDisplay
]

external [// procedures used
CRLF; Ws; Wo; Wc; Bytes2
StealFromBcplDisplay; AddToBcplDisplay; DumpBlockToStats
RaidReset; RAIDCode; ReadStrng; PrintAddrs; Confirm
@BGetBase; @BGetBasePtr; @XPutBase; @BGetBase32; @BPutBase32
@XSetReadBR; @RRead; @RWrite
BP; ReadFlags; VirtualPage; EmAddr; MkSmallPos; IGetBase
InitStats; CloseStats; IndexedPageIO; LookupPage; EqNIL

// OS procs used
Zero; ShowDisplayStream; CreateDiskStream

// statics used
EmulatorSpace; LastRealPageNo; @lvVPtr
dsp; @DisplayAddrHi
statsFP; statsFile; LispFmap
]

static [
VMDisplay = 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
]

structure String: [ length byte; char↑1,255 byte ]

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.
XSetReadBR(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 ReadAtom() = valof// obtains atom number from typein
[ let s = vec 50
unless ReadStrng(s) do RaidReset(" XXX")
let num=0
for i=1 to s>>String.length do
[ let c = (s>>String.char↑i)-$0
test (c ge 0) & (c le 7)
ifso num=num*8+c
ifnot resultis AtomNum(s)
]
resultis num
]

and ReadNum(radix) = valof// read number in given radix
[
let s = vec 50
unless ReadStrng(s) do RaidReset(" XXX")
let num=0
for i=1 to s>>String.length do
[ let c = (s>>String.char↑i)-$0
test (c ge 0) & (c ls radix)
ifso num=num*radix+c
ifnot RaidReset(" XXX")
]
resultis num
]

and ShowRealCore() be// Displays a segment page usage map
[
CRLF()
Ws (" State of virtual memory file: ")
Ws (IGetBase(IFPKey) eq IFPValidKey? "C", "Inc")
Ws ("onsistent")
CRLF(); CRLF()
let base = vec LastSegment+2; Zero(base, LastSegment+3)
let ndirty, nlocked = 0, 0
let bp = BP(0)
for i = 2 to BptSize do
[bp = bp+3// next one. Skips the dummy header
if bp>>BPT.LOCK
then nlocked = nlocked+1
let vp = bp>>BPT.VP
let bucket = vp<<VP.segment
if (bucket le LastSegment) & ((ReadFlags(vp) & DIRTYbit) ne 0)
then ndirty = ndirty+1
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); Ws(" pages in use"); CRLF()
let sp = " "
Ws(sp); Wo(base!(LastSegment+1)); Ws(" Empty"); CRLF()
Ws(sp); Wo(LastRealPageNo-base!(LastSegment+2))
Ws(" Total available pages"); CRLF()
Ws(sp); Wo(nlocked); Ws(" pages locked"); CRLF()
Ws(sp); Wo(ndirty); Ws(" pages dirty"); CRLF()
]

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
]

and DoYankDef() be
[
Ws(" from atom ")
let a = ReadAtom()
BGetBase32(DEFspace, DEFbase+(a lshift 1))
test EqNIL(lvVPtr)
ifso Ws ("[no definition")
ifnot [ Wc($[); PrintAddrs(DEFspace,DEFbase+(a lshift 1), 2) ]
Ws("] and smash it into definition cell of atom ")
let b = ReadAtom()
Ws("[was ")
PrintAddrs(DEFspace,DEFbase+(b lshift 1), 2)
Wc($])
if Confirm()
then [// since lvVPtr has been smashed by now...
BGetBase32(DEFspace, DEFbase+(a lshift 1))
BPutBase32(DEFspace,DEFbase+(b lshift 1), lvVPtr)
]
]