// 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&#77777) 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
  ]
(1799)
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)
	]
  ]
(1792)