// PeekSum.bcpl -- Peek.reports summary -- C. Thacker
// Copyright Xerox Corporation 1979
// Last modified November 22, 1979  3:42 PM by Boggs

get "streams.d"

external
[
// Incoming procedures
OpenFile; ReadBlock
Ws; Wss; Wns
Endofs; Gets; Closes; Puts
InitStrings; Usc; Zero

// Incoming statics
dsp
]

structure  STREC:
[
LINK word
LENGTH word	//OF THE STRING WHICH FOLLOWS
]

manifest
[
HTSIZE = 256
SYMTABSIZE = 5000
HASHMASK = 377B
STORESIZE = 10000
]

static
[
SSA; ESA; CSAE
ESS; S; SSS
CSTE; HASHTAB; OUT
LIST1; LIST2; LIST3
AltoIITable
NetworkNumber
]

//----------------------------------------------------------------------------
let PeekSum() be
//----------------------------------------------------------------------------
[
// open files
S = OpenFile("Peek.Reports", ksTypeReadOnly, charItem)
if S eq 0 then [ Ws("*NCan't open file Peek.Reports"); finish ] 

OUT = OpenFile("PeekSummary.tx", ksTypeWriteOnly, charItem)
if OUT eq 0 then [ Ws("Can't open file PeekSummary.tx"); finish ]

// set up tables
let v = vec SYMTABSIZE; Zero(v, SYMTABSIZE)
SSS, CSTE, ESS = v, v, v+SYMTABSIZE

let v = vec STORESIZE; Zero(v, STORESIZE)
SSA, CSAE, ESA = v, v, v+STORESIZE

let v = vec 256; Zero(v, 256); LIST1 = v

let v = vec 256; Zero(v, 256); LIST2 = v

let v = vec 256; Zero(v, 256); LIST3 = v

let v = vec 16; Zero(v, 16); AltoIITable = v
 
let v = vec HTSIZE; Zero(v, HTSIZE); HASHTAB = v

until Endofs(S) do
   [
   let TOK = vec 100
   let TERMCH = READX(S, TOK)	//read network number
   //print lines in Peek.reports that don't start with <netnumber>#
   if TERMCH ne $# then [ WNAME(OUT,TOK); Wss(OUT, "*N"); loop ]

   if NetworkNumber eq 0 then NetworkNumber = CSN(TOK)
   TERMCH = READX(S, TOK)	//read serial number
   if TERMCH ne $# then		//line screwed up--discard line
      [
      while TERMCH ne $*N do TERMCH = READX(S, TOK)
      loop
      ]
   let SN = CSN(TOK)

   TERMCH = READX(S, TOK)	//read something, hopefully a number
   if TERMCH ne $*S then	//if it doesn't end in <space>, discard line
      [
      while TERMCH ne $*N do TERMCH = READX(S, TOK)
      loop
      ]
   let V = vec 5
   let FN = CSD(TOK)
   //NOW GET THE NEXT ITEM IN THE LINE
   TERMCH = READX(S, TOK)
   switchon TERMCH into
      [
      case $*N:
         [
         test TOK!0 gr 5	//at most 5 chars in a number
            ifso		//TOK is text
               [
               V!0 = LOOKUP(TOK)
               V!1 = FN
               ADDTOLIST(LIST1,2,SN,V)
               ]
            ifnot		//TOK is number of RAM chip errors
               [
               V!0 = FN
               V!1 = CSD(TOK)
               ADDTOLIST(LIST3,2,SN,V)
               ]
         endcase
         ]

      case $*S:			//line describes bad main mem chip
         [
         V!0 = FN
         V!1 = CSD(TOK)
         TERMCH = READX(S,TOK)
         V!2 = CSD(TOK)
         if TERMCH eq $*N then
            [
            SetAltoIIBit(SN)		//this is an Alto II
            ADDTOLIST(LIST2,3,SN,V)
            loop
            ]
         TERMCH = READX(S,TOK)
         V!3 = CSD(TOK)
         if TERMCH ne $*N then loop
         ADDTOLIST(LIST2,4,SN,V)
         endcase
         ]

      default: loop
      ]
   ]

NOMORE()
]

//----------------------------------------------------------------------------
and ADDTOLIST(LIST, ITEMS, SN, V) be
//----------------------------------------------------------------------------
[
let LINK = LIST!SN
   [
   if LINK eq 0 break
   let FOUND = true
   for I = 1 to ITEMS-1 do if V!(I-1) ne LINK!I then [ FOUND = false; break ] 
   if FOUND then
      [
      //only smash current count with bigger count
      //so restart of DMT doesn't destroy record of previous errors
      //rshifts force ignorance of sign bit, with loss of bottom bit
      if Usc(LINK!ITEMS, V!(ITEMS-1)) ls 0 then LINK!ITEMS = V!(ITEMS-1)
      return
      ] 
   LINK = LINK!0
   ] repeat

// EXHAUSTED THE LIST. ADD V to STORAGE
let T = CSAE
CSAE = CSAE + ITEMS+1
if CSAE gr ESA then [ Ws("*NOVERFLOW!"); finish ] 
T!0 = LIST!SN
LIST!SN = T
for I = 1 to ITEMS do T!I = V!(I-1)
]

//----------------------------------------------------------------------------
and LOOKUP(TOKEN) = valof
//----------------------------------------------------------------------------
[ 
let H = 0
for I = 1 to TOKEN!0 do H = H + TOKEN!I
H = (H+(H rshift 8)) & HASHMASK
let X = HASHTAB!H
let FOUND = false
while (X ne 0) & not FOUND do
   [ 
   FOUND = true
   let P = lv X>>STREC.LENGTH
   for I = 0 to TOKEN!0 do
      [ 
      if TOKEN!I ne P!I then
         [ 
         FOUND = false
         break
         ]
      ]
   if not FOUND then X = X>>STREC.LINK
   ]

if FOUND resultis X
CSTE>>STREC.LINK = HASHTAB!H
HASHTAB!H = CSTE
let NEWCSTE = 2 + TOKEN!0 + CSTE
if NEWCSTE ge ESS then
   [ Ws("*NSYMBOL table OVERFLOW"); finish ]
let P = lv CSTE>>STREC.LENGTH
for I = 0 to TOKEN!0 do P!I = TOKEN!I	//COPY TOKEN
CSTE = NEWCSTE
resultis HASHTAB!H
]

//----------------------------------------------------------------------------
and CSN(TOKEN) = valof
//----------------------------------------------------------------------------
[
let N = 0
for I = 1 to TOKEN!0 do N = (N lshift 3) + ((TOKEN!I) & 7)
resultis N
]


//----------------------------------------------------------------------------
and CSD(TOKEN) = valof
//----------------------------------------------------------------------------
[
let BASE = 1
let X = 0
if TOKEN!0 eq 0 then [ Ws("*NUGLY NUMBER"); finish ] 
for I = TOKEN!0 by -1 to 1 do
   [
   X = BASE*(TOKEN!I - $0) + X
   BASE = BASE* 10
   ]
resultis X
]

//----------------------------------------------------------------------------
and READX(STREAM, T) = valof
//----------------------------------------------------------------------------
[
let NUM = false
let FIRST = true
T!0 = 0			//T!0 is number of characters in T
   [
   let CHAR = Gets(STREAM)
   switchon CHAR into
      [
      case $0 to $9:
         [
         if FIRST then [ FIRST = false; NUM = true ] 
         T!0 = (T!0) + 1
         T!(T!0) = CHAR
         endcase
         ]
      case $*N: resultis CHAR
      case $*S: case $*T:
         [
         if FIRST loop
         if NUM resultis CHAR
         ]
      default:
         [
         if NUM resultis CHAR
         FIRST = false
         T!0 = (T!0)+1
         T!(T!0) = CHAR
         ]
      ]
   ] repeat
]

//----------------------------------------------------------------------------
and WNAME(STREAM, NAME) be for I = 1 to NAME!0 do Puts(STREAM, NAME!I)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and SetAltoIIBit(SN) be
//----------------------------------------------------------------------------
   AltoIITable!(SN rshift 4) = (AltoIITable!(SN rshift 4)) %
    (#100000 rshift (SN & #17))

//----------------------------------------------------------------------------
and IsAltoII(SN) =
   ((AltoIITable!(SN rshift 4)) & (#100000 rshift (SN & #17))) eq 0? 0, 1
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and NOMORE() be
//----------------------------------------------------------------------------
[
Closes(S)
let Dir = OpenFile("PUP-NETWORK.DIRECTORY", ksTypeReadOnly, wordItem)

//allocate a few variables used inside ifso's and ifnot's
let base, addr = 0, 0

test Dir eq 0
   ifso Wss(OUT,"*NCouldn't open file PUP-NETWORK.DIRECTORY*N")
   ifnot
      [
      let n = ReadBlock(Dir, rv(#335), #177777)
      Closes(Dir)
      base = rv(#335)
      addr = base + rv(base + 3)
      while (rv(base + rv(addr) + 2) rshift 8) ne NetworkNumber do
         addr = addr + 1
      ]

Wss(OUT, "*NNetwork number ")
Wns(OUT, NetworkNumber, 2, 8)
Wss(OUT,"*N*N*N")

for I = 0 to 255 do
   [
   if LIST1!I eq 0 loop
   Wns(OUT, I, 3, 8)
   Wss(OUT,"--")
   if Dir ne 0 then
      [
      while (rv(base + rv(addr) + 2) & #377) ls I do addr = addr + 1
      test (rv(base + rv(addr) + 2) & #377) eq I
         ifso
            [
            Wss(OUT, base + rv(base + rv(base + rv(addr) + 1) + 6))
            Wss(OUT, "  ")
            Wss(OUT, base + rv(base + rv(base + rv(addr) + 1) + 4))
            ]
         ifnot Wss(OUT, "not in PUP-NETWORK.DIRECTORY")
      ]
   let flag = false
   let mylink = LIST1!I
   until mylink eq 0 do
      [
      if mylink!2 ne 0 then flag = true
      mylink = mylink!0
      ]
   if flag eq false then
      [
      Wss (OUT, " : NO ERRORS*N*N")
      loop
      ]
   let LINK = LIST1!I
   Wss(OUT, " :*N")
   until LINK eq 0 do
      [
      Wns(OUT,LINK!2, 5, 10)
      Wss (OUT, " ")
      WNAME(OUT, (LINK!1)+1)
      Wss(OUT, "*N")
      LINK = LINK!0
      ]

   LINK = LIST2!I
   if LINK ne 0 then
      [
      Wss(OUT, "*NMain memory chips ")
      test IsAltoII(I)
         ifso Wss(OUT, "(Alto II):*NCard  Chip  Errors*N")
         ifnot Wss(OUT, "(Alto I):*NCard  Col   Row   Errors*N")
      until LINK eq 0 do
         [
         for J = 1 to (2+(1-IsAltoII(I))) do
            [
            Wns(OUT, LINK!J, 2, 10)
            Wss(OUT, "    ")
            ]
         Wns(OUT, LINK!(3+(1-IsAltoII(I))), 5, 10)
         Wss(OUT, "*N")
         LINK = LINK!0
         ]
      ]

   LINK = LIST3!I
   if LINK ne 0 then Wss(OUT, "*NControl memory chips:*NChip  Errors*N")
   until LINK eq 0 do
      [
      Wns(OUT, LINK!1, 2, 10)
      Wss(OUT, "    ")
      Wns(OUT, LINK!2, 5, 10)
      Wss(OUT, "*N")
      LINK = LINK!0
      ]
   Wss(OUT, "*N*N")
   ]
Closes(OUT)
]