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