!File last changed on 11/02/83
!  *******************************************************************
!  *                                                                 *
!  *    THE JOURNAL SYSTEM:    PACKAGE C                             *
!  *    THIS PACKAGE CONTAINS THE ROUTINES THAT GIVE THE ICL         *
!  *    ENGINEERS INTERACTIVE CONTROL OF ERROR CHECKING.             *
!  *                                                                 *
!  *    DESIGNED AND WRITTEN BY JOHN HENSHALL                        *
!  *                                                                 *
!  *    JOHN MURISON                       VERSION: 015              *
!  *                                                                 *
!  *                                                                 *
!  *******************************************************************

constinteger  kent = 0, ercc = 1
constinteger  journalsite = kent

!********** SYSTEM ROUTINE SPECS

  recordformat  rf(integer  conad, filetype, datastart, dataend)
  systemroutinespec  connect(string (31) file, integer  mode,hole,
          project, record (rf)name  r, integername  flag)
  systemroutinespec  destroy(string (31) s, integername  flag)
  systemroutinespec  disconnect( string (31) file, integername  flag)
  systemroutinespec  modpdfile(integer  bp,string (18) pdfile,
          string (11) member,string (31) infile,integername  flag)

!**********EXTERNAL ROUTINE SPECS.

  recordformat  f parm(integer  dest,srce,p1,p2,p3,p4,p5,p6)
  externalintegerfnspec  dpon3(string (6) user,record (f parm)name  p,
          integer  invoc,msgtype,outno)
  externalintegerfnspec  dpermission(string (6) owner,user,
          string (8) date,string (11) file,integer  fsys,type,adprm)
  externalroutinespec  copy(string (255) s)
  externalroutinespec  define(string (255) s)
  externalroutinespec  deliver(string (255) s)
  externalroutinespec  list(string (255) s)
  externalroutinespec  journal analysis(string (255) s)
  externalroutinespec  journal(string (255) s)
  externalroutinespec  prompt(string (255) s)
  externalstringfnspec  date
  externalroutinespec  send(string (255) s)

!**********ROUTINE AND FUNCTION SPECS.

  integerfnspec  res str(string (255) a, string (255) b, string (*)name  c)
  externalroutinespec  read prompt reply(stringname  reply)
  externalintegerfnspec  s to i(string (255) s)
  externalstringfnspec  intostr(integer  value)
  systemstringfnspec  unpack date(integer  packed)
  systemstringfnspec  unpack time(integer  packed)

!**********CONSTANT ARRAYS.

conststring  (4) array  ocps(0:15,0:1) =         c 
"29??"(2),"2960","2970","2980","2972","2976","29??"(9),
"29??","2950","2956","2966","2988","29??"(*)

!**********CONSTANTS.

  constinteger  block = 4096
  !BYTES IN EPAGE.
  constinteger  max unit errors = 2000
  constinteger  terminal lines = 18
  !LINES OF OUTPUT ON ENGINEERS TERMINAL
  constinteger  yes = 1
  constinteger  no = 0
  constinteger  P series=0
  constinteger  S series=1

!**********EXTERNAL ROUTINE LIST

!  THE FOLLOWING EXTERNAL ROUTINES EXIST IN THIS MODULE AND ARE IN
!  ALPHABETIC ORDER OF APPEARANCE:

!    ENGINEER SUMMARY:  THIS ROUTINE ALLOWS THE ENGINEER TO LOOK AT A
!    TABLE OF HARDWARE ERRORS FOR THE PERIOD OF TIME GOVERNED BY THE PAGE
!    SPECIFIED. THE ENGINNER CAN GO ON TO LOOK AT THE ERRORS IN DETAIL
!    EITHER AT HIS CONSOLE OR ON PRINTER OUTPUT.

!    MAINLOG SUMMARY:  THIS ROUTINE ALLOWS THE ENGINEERS TO LOOK BACK AT
!    THE ORIGINAL MAINLOGS AND EXTRACT SUMMARY INFORMATION OR FULL DUMPS
!    FROM THEM.


!    TAPE LIBRARY:  THIS ROUTINE IS USED AS AN INTERACTIVE
!    LOOK AT TAPE MOUNTS AND FAILURE RATE OVER A FIXED PERIOD.
!    IT CAN BE RUN ON DEMAND AT ANY TIME TO PRODUCE A CURRENT(TO DATE)
!    REPORT ON EITHER THE TERMINAL OR THE PRINTER(OR BOTH)
!    OR IT CAN BE USED TO AMEND THE TAPE LIBRARY, IE REMOVE
!    A TAPE ENTRY OR CLEAR DOWN A DECK ENTRY ETC.



! ***********************************************
! ***********************************************
! ***********************************************

 externalroutine  jef(string (255) s)
  routinespec  terminal tape
  routinespec  printer tape
  routinespec  terminal disc
  routinespec  printer disc
  routinespec  translate smac error(integer  i)
  routinespec  terminal smac
  routinespec  printer smac
  routinespec  terminal drum
  routinespec  printer drum
  record  (f parm)p
  string (32) sumfile,tapefile,discfile,drumfile,smacfile,nowfile
  string (15) lpdev; lpdev = "LP"

  !--------------------------------------------
  !THE TAPE ERROR DISPLAY FORMATS AND DECLARATIONS FOLLOW.
  recordformat  f tape error(string (8) date,time,stream0,
          stream1,t0t3,t4t7,t8t11,transfers,fail lbe,failures,
          string (6) media,oper,type, string (2) dev,s0, string (8) t12t15)
  record (f tape error)arrayformat  af tape error(-19:max unit errors)
  record (f tape error)arrayname  tape error
  record (f tape error)name  te
  recordformat  f deck errors(string (2) deck,integerarray  ct(0:2,0:1))
  record (f deck errors)arrayformat  af deck errors(1:20)
  record (f deck errors)arrayname  deck errors
  record (f deck errors)name  de
  !THIS ARRAY ENABLES  THE PROGRAM TO LINK TABLE ENTRIES WITH TAPE DECKS
  !ON THE SYSTEM AND TO TOTAL ERRORS FOR EACH DECK.
  !CT COUNTS AS FOLLOWS:  0:2-> READ/WRITE/OTHER, 0:1-> RECOVERED/UNRECVRD
  !AND EACH ENTRY IS A COUNT OF AN ERROR ON THE SPECIFIC DECK.
  recordformat  f tsns(string (6) tsn,integer  events)
  recordformat  f track error(integerarray  trk(0:8),
          record (f tsns)array  tsns(1:100))
  record (f track error)arrayformat  af track error(1:20)
  record (f track error)arrayname  sterrors,mterrors
  record (f track error)name  ste, mte
  !THIS ARRAY STRUCTURE DEFINES THE REPORTING OF "SINGLE TRACK ERRORS"
  !AS FOLLOWS:
  !TRK: TOTALS OF THE ERRORS FOR THIS DECK BY TRACK.
  !TSNS: DETAILS OF INDIVIDUAL TAPES IN ERROR ON THAT DECK

  !MTE DEFINES A SIMULAR STRUCTURE FOR MULTI TRACK ERRORS.
  integer  single track errors
  integerarrayformat  af t f l(1:20,0:1,1:16)
  integerarrayname  tape fail levels
  !1:20  TAPE DECK(FROM TAPE CONTROL)
  !0:1   READ OR WRITE
  !1:16  TOTAL ERRORS AT THIS LEVEL(16=UNRECOVERED.)

  !-------------------------------------------------------
  !DECLARATIONS FOR DISC ERROR REPORTING.
  recordformat  f disc error(string (8) date, time,
          (string (8) stream0, stream1, cstatus, fail lbe, s0t2, t3t6,
          m0m3, tcount, fcount or  string (8) tcb response, fail tcb, s0t3,
          t4t7, t8ta, m0m1, m2m5, m6m9), string (4) dev, string (6) media, route,
          string (10) cyl inf, string (3) ertype)
  record (f disc error)arrayformat  af disc error(1:max unit errors)
  record (f disc error)arrayname  disc error
  record  (rf)r
  owninteger  printer lines
  owninteger  printer page
  owninteger  printer stream = 2
  owninteger  out lines
  conststring (18) icl dlv="ICL_2900_ENGINEERS"
  conststring (18) j dlv="Journal_Management"
  integer  fsys, i, j, m, flag, errors, epage
  string (20) current output,current summary
  current output="<Terminal>"
  string (32) ss, spdev
  string (120) st
  switch  swx(1:6)

  !-------------------------------------------------------
  !DECLARATIONS FOR SMAC ERROR REPORTING.
  recordformat  f smac error(string (1) smac, string (8) date,time,
          pointer,address,eng state,status,config,sei param,
          string (16) data)
  record (f smac error)arrayformat  af smac error(1:max unit errors)
  record (f smac error)arrayname  smac error
  !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  !BOARD/DILIC TRANSLATION TABLES AND VARIABLES.
  integer  ptr,saddr,data,smac,col,sblock,conf,blk 1 in bu,blk 0 in bu
  integer  chip type,board,word,bit,ocptype,systype,byte,module,row,pos
  integer  status,previous status,tline,sub block,hwsmac
  previous status=0
  string (3) dilic,platter; string (2) unit
  owninteger  p3 postmultisingle bit mask = x'00000280'
  owninteger  p4 single bit mask = x'00000280'
  owninteger  p3 smac error mask = x'000EE3BC'
  owninteger  p3 smac info mask = x'00F00040'
  owninteger  p4 smac error mask = x'0000FFFA'
  owninteger  p4 smac info mask = x'00F30001'
  string (60) array  translation(1:2)
  conststring (24) array  p3 smac fail(1:24)= c 
  "","","A.U.ADDR PAR. FAIL","CONTROL PARITY FAIL","HOLDING FAULT",
  "'C' TOGGLE SET","READING FAULT","SINGLE BIT HAMM. FAULT",
  "MULTIBIT HAMM. FAULT","POST MULTIBIT FAULT","",
  "","","BYTE FUNC. PARITY FAULT","ADDRESS PARITY FAIL",
  "BYTE PARITY FAIL","","I.S. NACK","HAMM. CORR. FAIL",
  "HAMM. GEN FAIL","PORT 3 FAIL","PORT 2 FAIL","PORT 1 FAIL",
  "PORT 0 FAIL"
  conststring (29) array  p4 smac fail(1:24)= c 
    "PARITY-PARITY FAIL FLD 2","BU POWER SUPPLY STATUS","",
    "CONTROL PARITY FAIL","PORT HOLDING",
    "FAIL DURING INTER PROC. COMM.","FAIL DURING SMAC IS.",
    "CHECK POSN FAIL",
    "MULTI BIT FAIL","SINGLE BIT FAIL,DATA MOD.",
    "POWER SUPPLY WARNING","POWER SUPPLY FAULT",
    "IMAGE STORE ACCESS FAULT","BYTE FUNC. PARITY FAIL",
  "ADDRESS PARITY FAIL","DATA PARITY FAIL","PARITY-PARITY FAIL FLD 1",
    "PARITY-PARITY FAIL FLD 0","","","PORT 3 ACCESS FAULT",
    "PORT 2 ACCESS FAULT","PORT 1 ACCESS FAULT","PORT 0 ACCESS FAULT"
  constbyteintegerarray  ham p3 smac(1:72)=64,65,0,66,1,2,3,67,4,5,6,7,
          8,9,10,68,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
          25,69,26,27,28,29,30,31,32,33,34,35,36,37,38,39,
          40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,70,57,
          58,59,60,61,62,63,71
  constbyteintegerarray  bu 0 2970(0:71)= c 
          2,4,6,8,10,12,2,4,6,8,10,12,2,4,6,8,10,12,2,4,6,8,10,12,
          2,4,6,8,10,12,2,4,
          2,4,6,8,10,12,2,4,6,8,10,12,2,4,6,8,10,12,2,4,6,8,10,12,
          2,4,6,8,10,12,2,4,6,8,10,12,6,8,10,12
  constbyteintegerarray  bu 1 2970(0:71)= c 
          1,3,5,7,9,11,1,3,5,7,9,11,1,3,5,7,9,11,1,3,5,7,9,11,
          1,3,5,7,9,11,1,3,
          1,3,5,7,9,11,1,3,5,7,9,11,1,3,5,7,9,11,1,3,5,7,9,11,
          1,3,5,7,9,11,1,3,5,7,9,11,5,7,9,11
  constbyteintegerarray  au odd 2970(0:71)= c 
          2,4,6,8,10,12,2,4,6,8,10,12,2,4,6,8,10,12,2,4,6,8,10,12,
          2,4,6,8,10,12,2,4,
          14,16,18,20,22,24,14,16,18,20,22,24,14,16,18,20,22,24,
          14,16,18,20,22,24,14,16,18,20,22,24,14,16,
          6,8,10,12,18,20,22,24
  constbyteintegerarray  au even 2970(0:71)= c 
          3,5,7,9,11,13,3,5,7,9,11,13,3,5,7,9,11,13,3,5,7,9,11,13,
          3,5,7,9,11,13,3,5,
          15,17,19,21,23,25,15,17,19,21,23,25,15,17,19,21,23,25,
          15,17,19,21,23,25,15,17,19,21,23,25,15,17,
          7,9,11,13,19,21,23,25
  conststring (3) array  dilic 8049(0:95)= c 
          "B29","D29","F29","H29","B28","D28","F28","H28"," B2",
          " D2"," F2"," H2"," B1"," D1"," F1"," H1","B27","D27",
          "F27","H27","B26","D26","F26","H26"," B4"," D4"," F4",
          " H4"," B3"," D3"," F3"," H3","B25","D25","F25","H25",
          "B24","D24","F24","H24"," B6"," D6"," F6"," H6"," B5",
          " D5"," F5"," H5"," B3","D23","F23","H23","B22","D22",
          "F22","H22"," B8"," D8"," F8"," H8"," B7"," D7"," F7",
          " H7","B21","D21","F21","H21","B20","D20","F20","H20",
          "B10","D10","F10","H10"," B9"," D9"," F9"," H9","B19",
          "D19","F19","H19","B18","D18","F18","H18","B12","D12",
          "F12","H12","B11","D11","F11","H11"
  conststring (3) array  dilic t032(0:95)= c 
          "C13","D13","E13","F13","C14","D14","E14","F14",
          "C15","D15","E15","F15","C16","D16","E16","F16",
          "C19","D19","E19","F19","C20","D20","E20","F20",
          "C21","D21","E21","F21","C22","D22","E22","F22",
          "C23","D23","E23","F23","C24","D24","E24","F24",
          "C17","D17","E17","F17","C18","D18","E18","F18",
          " C1"," D1"," E1"," F1"," C2"," D2"," E2"," F2",
          " C5"," D5"," E5"," F5"," C6"," D6"," E6"," F6",
          " C7"," D7"," E7"," F7"," C8"," D8"," E8"," F8",
          " C9"," D9"," E9"," F9","C10","D10","E10","F10",
          "C11","D11","E11","F11","C12","D12","E12","F12",
          " C3"," D3"," E3"," F3"," C4"," D4"," E4"," F4"
  constintegerarray  bu 0 2980 w01(0:5)=15,17,19,22,24,26
  constintegerarray  bu 0 2980 w23(0:5)=12,10,8,5,3,1
  constintegerarray  bu 1 2980 w01(0:5)=14,16,18,21,23,25
  constintegerarray  bu 1 2980 w23(0:5)=13,11,9,6,4,2
  constintegerarray  au even 2980 w01(0:5)=15,17,19,21,23,25
  constintegerarray  au even 2980 w23(0:5)=3,5,7,9,11,13
  constintegerarray  au odd 2980 w01(0:5)=14,16,18,20,22,24
  constintegerarray  au odd 2980 w23(0:5)=2,4,6,8,10,12
  constintegerarray  t col(0:7)=1,5,2,6,3,7,4,8
  !USED IN P3(2960) SMAC TRANSLATION TO DILIC.
  conststring (1) array  tohex(0:15)= c 
    "0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F"

  !----------------------------------------
  !DECLARATIONS FOR DRUM ERROR REPORTING.
  recordformat  f drum sector(string (8) word1,word2,string (32) desc)
  recordformat  f drum error(string (8) date,time,
          string (6) route,string (4) ertype,
          string (8)array  stream(0:4),
          record (f drum sector)array  drum sector(1:8))
  record (f drum error)arrayformat  af drum error(1:max unit errors)
  record (f drum error)arrayname  drum error

  !-------------------------------------------------------
  routine  display index
     recordformat  rf e hd(integer  from,to,next)
     recordformat  rf eng hd(integer  first,
            record (rf e hd)array  entry(1:10))
     record (rf eng hd)name  eng hd
     record  (rf)r
     integer  i, flag
   
     !--------------------------------------------------------
     !CODE COMMENCES HERE.
     connect("JENGPD_JENGHD",0,0,0,r,flag)
     if  flag#0 start 
       printstring("Journal:  Engineering file lost??")
       newline
       printstring("          Contact System Management")
       newlines(2)
       stop 
     finish 
     eng hd==record(r_conad+x'20')
     systype=integer(r_conad+x'FC')
     systype = S series if  systype#P series
     ocptype=integer(r_conad+x'100')
     ocptype = 0 unless  0<=ocptype<=15
     select output(0)
     newpage
     printsymbol('-') for  i=1,1,50
     newline
     printstring("EMAS ".ocps(ocptype,systype).": Index of On")
     printstring("line Engineering Summaries")
     newline
     i=eng hd_first
     printstring("PAGE   FROM"); spaces(15); printstring("TO")
     newline
     cycle 
       write(i,3)
       spaces(3)
       printstring(unpackdate(eng hd_entry(i)_from)." ")
       printstring(unpacktime(eng hd_entry(i)_from)."  ")
       printstring(unpackdate(eng hd_entry(i)_to)." ")
       printstring(unpacktime(eng hd_entry(i)_to))
       newline
       exit  if  eng hd_entry(i)_next=0
       i=eng hd_entry(i)_next
     repeat 
     newline
     printsymbol('-') for  i=1,1,50
     newline
     disconnect("JENGPD_JENGHD",flag)
     return 
  end ;  !OF DISPLAY INDEX.

  routine  hex to bin(stringname  s,integername  z)
    integer  l, ch, bb, xx
    xx=1; z=0
    l=length(s)
    unless  0<l<10 start 
      printstring("Journal:  bad hex string(".S."), ignored!!")
      newline
      return 
    finish 
    cycle  bb=1,1,l
      ch=byteinteger(addr(s)+bb)-'0'
      if  ch>x'10' then  ch=(ch&x'0F')+x'09'
      z=z!(ch<<(4*(l-xx)))
      xx=xx+1
    repeat 
  end ;  !OF HEX TO BIN

  integer  limited access;  limited access = no
!------------------------------------------
!MAIN INTERACTION CONTROL LOOP CODE FOLLOWS.
!------------------------------------------
  connect("JENGPD",0,0,0,r,flag)
  if  flag # 0 start 
    !WE ARE PROBABLY NOT IN THE MAIN JOURNL PROCESS.
    copy("JOURNL.JENGPD,JENGPD")
    connect("JENGPD",0,0,0,r,flag)
    printstring("No JEF service.") and  newline c 
     and  stop  if  flag # 0
    limited access = yes
  finish 
  disconnect("JENGPD",flag)
  epage=block//1024
  cycle 
    display index
    current summary="?"
    cycle 
      printstring(current output."<Summary: ".current summary.">")
      newline
      prompt(": ")
      read prompt reply(st)
      return  if  st="STOP" or  st="S"
      if  st="NOW" or  st="N" start 
        if  limited access = yes then  printstring("Not permitted.") C 
         and  newline and  stop 
        current summary="NOW"
        exit 
      finish 
      if  st="NOWLIST" then  current summary=st and  exit 
      if  length(st)<=2 start 
        i = s to i(st)
        if  1<=i<=10 then  current summary=st and  exit 
      finish 
      if  res str(st,"PRINTER",st)=yes or  res str(st,"P",st)=yes start 
        if  st # "" start 
          if  res str(st," ",st)=yes then  lpdev = st else  c 
            printstring("??") and  newline and  continue 
        finish 
        if  lpdev = "LP" then  current output = "<Local Printer>" c 
           else  current output = "<Printer ".lpdev.">"
      finish 
      if  st="TERMINAL" or  st="T" then  current output= c 
       "<Terminal>"
      printstring("Please define Summary required."); newline
    repeat 
new summary:
    if  current summary="NOW" or  current summary="NOWLIST" start 
      sumfile="JSUM"; tapefile="JTAPE"; discfile="JDISC"
      smacfile="JSMAC"; drumfile="JDRUM"
      p_dest=x'FFFF0000'!27
      j=dpon3("DIRECT",p,0,1,7)
      if  j#0 start 
        printstring("Failure in DIRECT call: ".INTOSTR(FLAG))
        newline; return 
      finish 
      if  p_p1#0 start 
        printstring("Failure in SPOOLR call: ".INTOSTR(P_P1))
        newline; return 
      finish 
      i=p_p2>>24
      nowfile="".intostr(i)
      if  length(nowfile)=1 then  nowfile="0".nowfile
      fsys=i
      i=(p_p2<<8)>>8
      ss=intostr(i)
      cycle 
        exit  if  length(ss)=4
        ss="0".ss
      repeat 
      nowfile=nowfile.ss
      i=dpermission("SPOOLR","JOURNL",date,nowfile,fsys,2,1)
      if  i#0 start 
        printstring("DPERMISSION fails: ".INTOSTR(I)." ,sorry!")
        newline; return 
      finish 
      copy("SPOOLR.".nowfile.",JENGSP")
      i=dpermission("SPOOLR","JOURNL",date,nowfile,fsys,3,1)
      if  i#0 start 
        printstring("DUNPERMISSION fails: ".intostr(i))
        newline
      finish 
      if  current summary="NOWLIST" then  c 
        send("JENGSP,.".lpdev) and  stop 
      connect("JENGSP",0,0,0,r,flag)
      if  flag#0 start 
        printstring("Current log not available, flag: ".INTOSTR(FLAG))
        newline; return 
      finish 
      newpage
     printstring("Engineering Summary follows for the following period")
      newline
      printstring(unpackdate(integer(r_conad+x'14'))."(")
      printstring(unpacktime(integer(r_conad+x'14')).") to the ")
      printstring("present time."); newline
      journal analysis("ENGSPECIAL")
    finish  else  start 
      connect("JENGPD_JSUM".current summary,0,0,0,r,flag)
      if  flag#0 start 
        printstring("Journal:  summary page lost, check your reply")
        newline
        printstring("          otherwise contact system manager.")
        newlines(2)
        return 
      finish 
      disconnect("JENGPD_JSUM".current summary,flag)
      sumfile="JENGPD_JSUM".current summary
      tapefile="JENGPD_JTAPE".current summary
      discfile="JENGPD_JDISC".current summary
      smacfile="JENGPD_JSMAC".current summary
      drumfile="JENGPD_JDRUM".current summary
    finish 
    list(sumfile)
    cycle 
      cycle 
        newline
        printstring(current output."<Summary: ".current summary.">")
        newline
        prompt(": ")
        read prompt reply(st)
        if  st="INDEX" or  st="I" then  i=1 and  exit 
        if  res str(st,"PRINTER",st)=yes or  res str(st,"P",st)=yes start 
          if  st # "" start 
            if  res str(st," ",st)=yes then  lpdev = st else  c 
              printstring("??") and  newline and  continue 
          finish 
          if  lpdev = "LP" then  current output = "<Local Printer>" c 
           else  current output = "<Printer ".lpdev.">"
          -> round
        finish 
        if  st="TERMINAL" or  st="T" then  current output= c 
         "<Terminal>" and  -> round
        if  st="STOP" or  st="S" then  i=6 and  exit 
        if  res str(st,"DISC",ss)=yes then  i=2 and  exit 
        if  res str(st,"DRUM",ss)=yes then  i=3 and  exit 
        if  res str(st,"TAPE",ss)=yes then  i=4 and  exit 
        if  res str(st,"SMAC",ss)=yes then  i=5 and  exit 
        if  st="NOW" or  st="N" start 
          if  limited access = no then  i=6 and  exit 
          printstring("Not available.")
          newline; stop 
        finish 
        if  length(st)<=2 start 
          i = s to i(st)
          if  1<=i<=10 then  i=6 and  exit 
        finish 
        printstring("Check your reply!!"); newline
round:
      repeat 
      ->swx(i)

swx(1):  !RETURN TO THE INDEX
      exit 

swx(2):  !DISC REPORTING REQUIRED
      if  ss#"" start 
        if  res str(ss," ED",spdev)=yes and  length(spdev)=2 c 
         then  spdev="ED".spdev else  start 
          printstring("FORMAT: 'DISC EDXX' for specific reporting.")
          newline
          ->next
        finish 
      finish  else  spdev="ALL"
      outlines=terminal lines+1
      if  current output="<Terminal>" then  terminal disc else  c 
       printer disc
      ->next

swx(3):  !DRUM REPORTING REQUIRED
      if  ss#"" start 
        unless  res str(ss," ",spdev)=yes and  length(spdev)=5 start 
          printstring("FORMAT: 'DRUM P/T/S' for specific reporting.")
          newline
          ->next
        finish 
      finish  else  spdev="ALL"
      outlines=terminal lines+1
      if  current output="<Terminal>" then  terminal drum else  c 
       printer drum
      ->next
swx(4):  !TAPE REPORTING REQUIRED
      if  ss#"" start 
        unless  res str(ss," M",spdev)=yes and  length(spdev)=2 start 
          printstring("FORMAT: 'TAPE MXX' for specific reporting.")
          newline
          ->next
        finish 
      finish  else  spdev="ALL"
      outlines=terminal lines+1
      if  current output="<Terminal>" then  terminal tape else  c 
       printer tape
      ->next
swx(5):  !SMAC REPORTING REQUIRED
      if  ss#"" start 
        unless  res str(ss," ",spdev)=yes and  length(spdev)=1 start 
          printstring("FORMAT: 'SMAC X' for specific reporting.")
          newline
          ->next
        finish 
      finish  else  spdev="ALL"
      outlines=terminal lines+1
      if  current output="<Terminal>" then  terminal smac else  c 
       printer smac
      ->next

swx(6):  !STOP OR ANOTHER SUMMARY
      if  current summary="NOW" start 
        destroy("JSUM",flag);destroy("JTAPE",flag)
        destroy("JDISC",flag);destroy("JSMAC",flag)
        destroy("JENGSP",flag);destroy("JDRUM",flag)
      finish 
      return  if  st="STOP" or  st="S"
      current summary=st
      current summary="NOW" if  current summary="N"
      ->new summary
next:
    repeat 
  repeat 
!-------------------------------
!END OF INTERACTION CONTROL LOOP
!-------------------------------


!*******************************************************
! A REPORT ON TAPE ERRORS TO BE GIVEN ON THE TERMINAL.
!*******************************************************
  routine  terminal tape
  integer  start, i, j, k
  select output(0)
  connect(tapefile,0,0,0,r,flag)
  if  flag#0 start 
    printstring("Tape summary file lost,  sorry")
    newlines(2)
    return 
  finish 
  tape error==array(r_conad+x'cd90',af tape error)
  deck errors==array(r_conad+x'40',afdeck errors)
  tape fail levels==array(r_conad+x'c390',af tfl)
  mterrors==array(r_conad+x'6300',af track error)
  sterrors==array(r_conad+x'270',af track error)
  errors=integer(r_conad+x'1C')
  single track errors=integer(r_conad+x'10')
  if  errors=0 and  single track errors=0 start 
    printstring("No tape errors recorded in this period.")
    newlines(2)
    return 
  finish 
  if  errors=0 then  ->skipmtt
  start=0
  for  i=1,1,errors cycle 
    te == tape error(i)
    if  spdev="ALL" or  spdev=te_dev start 
    if  out lines>=terminal lines start 
      if  start#0 start 
        cycle 
          prompt("CONTINUE:")
          read prompt reply(st)
          exit  if  res str(st,"Y",ss)=yes or  res str(st,"N",ss)=yes
        repeat 
        if  res str(st,"N",ss)=yes start 
          newline
          printstring("Chonological summary terminated,")
          printstring(" Deck summary follows.")
          newline
          ->skipmtt
        finish 
      finish  else  start=1
      newpage
      out lines=4
      printstring(" DATE TIME  DEV MEDIA  OP LVL STREAMR0 STREAMR1")
      printstring(" S0T0T1T2T3T4T5T6T7T8T91011121314")
      newline
      printsymbol('-') for  j=1,1,80
      newlines(2)
    finish 
    st=te_date
    length(st)=length(st)-3
    st=st." ".te_time
    length(st)=length(st)-3
    st=st." M".te_dev." ".te_media." "
    j=length(st)
    st=st.te_oper
     length(st)=j+2
    j=length(st)
    st=st." ".te_type
    length(st)=j+3
    st=st."  ".te_stream0." ".te_stream1
    st=st." ".te_s0.te_t0t3.te_t4t7
    st=st.te_t8t11.te_t12t15
    length(st)=length(st)-2; ! Omit MG byte (gives deck type) - no space.
    printstring(st)
    newline
    out lines=out lines+1
    finish 
  repeat 
 printstring("Chronological summary completed, deck summary follows")
  newline
skipmtt:
  for  j=1,1,20 cycle 
    de == deck errors(j)
    ste == st errors(j)
    mte == mt errors(j)
    exit  if  de_deck=""
    !IE ALL DECKS REPORTED ON
    if  de_deck=spdev or  spdev="ALL" start 
    cycle 
      prompt("CONTINUE:")
      read prompt reply(st)
      exit  if  res str(st,"Y",ss)=yes or  res str(st,"N",ss)=yes
    repeat 
    if  res str(st,"N",ss)=yes start 
      printstring("Summary terminated.")
      newlines(2)
      return 
    finish 
    newpage
    printstring("Summary for tape deck: M".de_deck)
    spaces(45)
    newline
    printstring("Total errors(read/write/other)")
    printstring("  rcvd(".INTOSTR(DECK ERRORS(J)_CT(0,0)))
    printstring("/".intostr(de_ct(1,0)))
    printstring("/".intostr(de_ct(2,0)).")")
    printstring("  unrcvd(".intostr(de_ct(0,1)))
    printstring("/".intostr(de_ct(1,1))."/")
    printstring(intostr(de_ct(2,1)).")")
    newline
    printstring("Level:    1   2   3   4   5   6   7   8   9  10")
    printstring("  11  12  13  14  15 UNR")
    newline
    printsymbol('-') for  k=1,1,71
    newline
     printstring("Read:  ")
    for  k=1,1,16 cycle 
      write(tape fail levels(j,0,k),3)
    repeat 
    newline
    printstring("Write: ")
    for  k=1,1,8 cycle 
      write(tape fail levels(j,1,k),3)
    repeat 
    spaces(28); write(tape fail levels(j,1,16),3)
    newline
    printstring("Track errors: trk28 trk27 trk26 trk25 trk24 trk23")
    printstring(" trk22 trk21 trk20")
    newline
    printsymbol('-') for  i=1,1,67
    newline
    printstring("Single:      ")
    for  i=8,-1,0 cycle 
      write(ste_trk(i),5)
    repeat 
    newline
    printstring("Multi:       ")
    for  i=8,-1,0 cycle 
      write(mte_trk(i),5)
    repeat 
    newlines(2)
    printstring("MTE tape errors: ")
    k=-1
    for  i=1,1,100 cycle 
      exit  if  mte_tsns(i)_tsn=""
      if  k=0 then  newline and  spaces(17)
      k=0 if  k=-1
      k=k+1
      st=" ".mte_tsns(i)_tsn."("
      st=st.intostr(mte_tsns(i)_events).")"
      printstring(st); spaces(12-length(st))
      if  k=4 then  k=0
      if  i=10 start 
        printstring("**See printer analysis**")
        exit 
      finish 
    repeat 
    newline
    printstring("STE tape errors: ")
    k=-1
    for  i=1,1,100 cycle 
      exit  if  ste_tsns(i)_tsn=""
      if  k=0 then  newline and  spaces(17)
      k=0 if  k=-1
      k=k+1
      st=" ".ste_tsns(i)_tsn."("
      st=st.intostr(ste_tsns(i)_events).")"
      printstring(st); spaces(12-length(st))
      if  k=4 then  k=0
      if  i=10 start 
        printstring("**See printer analysis**")
        exit 
      finish 
    repeat 
    newline
    finish 
  repeat 
  printstring("Summaries completed."); NEWLINE
  return 
  end ;  !OF ROUTINE TERMINAL TAPE

!***************************************************
!A REPORT ON TAPE ERRORS TO BE SENT TO THE PRINTER.
!***************************************************
  routine  printer tape
  integer  winteger, j, k, l
  string (16) wstring1
  connect(tapefile,0,0,0,r,flag)
  if  flag#0 start 
    printstring("Tape error report lost,  sorry!")
    newline
    return 
  finish 
  tape error==array(r_conad+x'cd90',af tape error)
  deck errors==array(r_conad+x'40', af deck errors)
  tape fail levels==array(r_conad+x'c390',af tfl)
  mterrors==array(r_conad+x'6300',af track  error)
  sterrors==array(r_conad+x'270',af track error)
  errors=integer(r_conad+x'1C')

  single track errors=integer(r_conad+x'10')
  if  errors=0 and  single track errors=0 start 
    printstring("No tape errors recorded")
    newline
    return 
  finish 
  define("STREAM".intostr(printer stream).",JLP")
  select output(printer stream)
  printer lines=50
  printer page=1
  if  errors=0 then  ->skipmtp
  for  j=1,1,errors cycle 
    if  printer lines=50 start 
      printer lines=0
      newpage
      printstring("EMAS ".ocps(ocptype,systype)." Tape Error Report Page:")
      write(printer page,2)
      printer page=printer page+1
      newlines(2)
      printstring("  DATE      TIME    DEV  MEDIA   OP.  FAIL")
      printstring("  LVL SINCE LAST IPL  STREAM RESPONSE--")
      printstring(" STREAM STATUS:"); spaces(17)
      printstring("FAILED")
      newline; spaces(48)
      printstring("TRNSFERS/FAILS  WORD 0   WORD 1   S0 ")
      printstring("T0T1T2T3 T4T5T6T7 T8T91011 121314MG  LBE")
      newline
      printsymbol('-') for  k=1,1,130
      newlines(2)
    finish 
    te == tape error(j)
    printstring(te_date."  ".te_time)
    printstring("  M".te_dev."  ".te_media)
    printstring(" ".te_oper)
    if  te_oper="READ" then   spaces(1)
    printstring(" ".te_type)
    hex to bin(te_failures,winteger)
    winteger=winteger&x'0000FFFF'
    write(winteger,3)
    hex to bin(te_transfers,winteger)
    wstring1=intostr(winteger)
    hex to bin(te_failures,winteger)
    winteger=winteger>>16
    wstring1=wstring1."/".intostr(winteger)
    spaces(16-length(wstring1))
    printstring(wstring1."  ")
    printstring(te_stream0." ".te_stream1)
    printstring(" ".te_s0." ".te_t0t3)
    printstring(" ".te_t4t7." ".te_t8t11)
    printstring(" ".te_t12t15."  ".te_fail lbe)
    newlines(2)
    printer lines=printer lines+2
  repeat 
skipmtp:
  for  j=1,1,20 cycle 
    de == deck errors(j)
    exit  if  de_deck=""
    !No more decks to report failures on
    newpage
    printstring("EMAS ".ocps(ocptype,systype).":  Error report for tape deck: M")
    printstring(de_deck)
    newlines(3)
    !FIRSTLY REPORT ON SINGLE TRACK ERRORS FOR THIS DECK.
    printstring("Single track error summary:")
    newline
    printstring("Total recoveries per track:")
    spaces(32)
    printstring("Tapes in error(failure count):")
    newline
    printstring(" TRK28 TRK27 TRK26 TRK25 TRK24 TRK23 TRK22 ")
    printstring("TRK21 TRK20   TAPE(FAILS)  TAPE(FAILS)  ")
    printstring("TAPE(FAILS)  TAPE(FAILS)  TAPE(FAILS)")
    newline
    printsymbol('-') for  k=1,1,120
    newlines(2)
    ste == st errors(j)
    for  l=8,-1,0 cycle 
      write(ste_trk(l),5)
    repeat 
    m=0; spaces(2)
    for  l=1,1,100 cycle 
      exit  if  ste_tsns(l)_tsn=""
      m=m+1
      s="  ".ste_tsns(l)_tsn."("
      s=s.intostr(ste_tsns(l)_events).")"
      printstring(s);spaces(13-length(s))
      if  m=5 start 
        m=0; newline
        spaces(56)
      finish 
    repeat 
    newlines(4)
    printstring("Multi track error summary:")
    newline
    printstring("Total failures per track:")
    spaces(34)
    printstring("Tapes in error(failure count):")
    newline
    printstring(" TRK28 TRK27 TRK26 TRK25 TRK24 TRK23 TRK22 ")
    printstring("TRK21 TRK20   TAPE(FAILS)  TAPE(FAILS)  ")
    printstring("TAPE(FAILS)  TAPE(FAILS)  TAPE(FAILS)")
    newline
    printsymbol('-') for  k=1,1,120
    newlines(2)
    mte == mt errors(j)
    for  l=8,-1,0 cycle 
      write(mte_trk(l),5)
    repeat 
    m=0; spaces(2)
    for  l=1,1,100 cycle 
      exit  if  mte_tsns(l)_tsn=""
      m=m+1
      s="  ".mte_tsns(l)_tsn."("
      s=s.intostr(mte_tsns(l)_events).")"
      printstring(s); spaces(13-length(s))
      if  m=5 start 
        m=0; newline
        spaces(56)
      finish 
    repeat 
    newlines(4)
    printstring(          "Breakdown of errors on this deck:")
    newlines(2)
    spaces(16)
    printstring("  READ   WRITE   OTHER")
    newline; spaces(16)
    printstring("----------------------")
    newlines(2); printstring("RECOVERED :"); spaces(5)
    write(de_ct(0,0),5); spaces(2)
    write(de_ct(1,0),5); spaces(2)
    write(de_ct(2,0),5)
    newlines(2)
    printstring("UNRECOVERED :"); spaces(3)
    write(de_ct(0,1),5); spaces(2)
    write(de_ct(1,1),5); spaces(2)
    write(de_ct(2,1),5)
    newlines(2)
    newlines(3)
    printstring("    RECOVERY ")
    printstring("LEVEL:     1     2     3     4     5     6     ")
    printstring("7     8")
    printstring("     9    10    11    12    13    ")
    printstring("14    15   UNRECOVERED")
    newline
    printsymbol('-') for  k=1,1,123
    newlines(2)
    printstring("Total read fails:  ")
    for  k=1,1,15 cycle 
      write(tape fail levels(j,0,k),5)
    repeat 
    spaces(7); write(tape fail levels(j,0,16),5)
    newlines(2)
    printstring("Total write fails: ")
    for  k=1,1,8 cycle 
      write(tape fail levels(j,1,k),5)
    repeat 
    spaces(49); write(tape fail levels(j,1,16),5)
    newlines(3)
    printstring("End of report for deck M".de_deck)
    newlines(2)
  repeat 
  newpage
  select output(0)
  close stream(printer stream)
  deliver(icl dlv)
  send("JLP,.".lpdev)
  deliver(j dlv)
  end ;  !OF ROUTINE PRINTER TAPE

!****************************************************
!A REPORT ON DISC ERRORS TO BE GIVEN ON THE TERMINAL.
!****************************************************
  routine  terminal disc
   integer  i, j
   record (f disc error)name  de
  connect(discfile,0,0,0,r,flag)
  if  flag#0 start 
    printstring("Disc error report lost, sorry.")
    newlines(2)
    return 
  finish 
  errors=integer(r_conad+x'1C')
  if  errors=0 start 
    printstring("No disc errors recorded.")
    newlines(2)
    return 
  finish 
  disc error==array(r_conad+x'40',af disc error)
  for  i=1,1,errors cycle 
    de == disc error(i)
    if  spdev="ALL" or  spdev=de_dev start 
    if  outlines>=terminal lines start 
      if  out lines=terminal lines start 
        cycle 
          prompt("Continue:")
          read prompt reply(st)
          exit  if  res str(st,"Y",ss)=yes or  res str(st,"N",ss)=yes
        repeat 
        if  res str(st,"N",ss)=yes start 
          printstring("Summary terminated.")
          newline
          return 
        finish 
      finish 
      newpage
      if  systype=P series start ; ! P Series heading.
         printstring("TIME  UNIT MEDIA  ROUTE   STREAMR0 STREAMR1 SEEK INF")
         printstring("   S0T0T1T2T3T4T5T6 ")
         newline
         printsymbol('-') for  j=1,1,70
      finishelsestart ; ! S Series heading
         printstring("Time  Unit Media  Route   Seek Inf  S0T1T2T3T4T5T6T7T8T9TA")
         printstring(" M0M1M2M3M4M5 M6M7M8M9")
         newline
         printsymbol('-') for  j=1,1,80
      finish 
      newlines(2)
      out lines=4
    finish 
    st=de_time
    length(st)=length(st)-3
    st=st." ".de_dev."  ".de_media
    printstring(st)
    if  de_ertype="???" then  c 
    printstring("****Record lost****") else  start 
      if  systype=P series start 
         st=" ".de_route."  ".de_stream0." ".de_stream1
         if  de_cyl inf="" then  st=st."           " else  c 
         st=st." ".de_cyl inf
         if  de_ertype="BDS" then  st=st."?" else  st=st." "
         st=st.de_s0t2.de_t3t6
         printstring(st)
      finishelsestart ; ! S series
         printstring(" ".de_route." ".de_cyl inf." ")
         printstring(de_s0t3.de_t4t7.de_t8ta." ")
         printstring(de_m0m1.de_m2m5." ".de_m6m9)
      finish 
    finish 
    newline
    outlines=out lines+1
    finish 
  repeat 
  printstring("Summary completed.")
  newline
  return 
  end ;  !OF ROUTINE TERMINAL DISC

!**************************************************
!A REPORT OF DISC ERRORS TO BE SENT TO THE PRINTER.
!**************************************************
  routine  printer disc
  integer  i, j
  record (f disc error)name  de
  connect(discfile,0,0,0,r,flag)
  if  flag#0 start 
    printstring("Disc error report lost,  sorry!")
    newline
    return 
  finish 
  disc error==array(r_conad+x'40',af disc error)
  errors=integer(r_conad+x'1C')
  if  errors=0 start 
    printstring("No disc errors recorded.")
    newline
    return 
  finish 
  define("STREAM".intostr(printer stream).",JLP")
  select output(printer stream)
  printer lines=50
  printer page=1
  for  j=1,1,errors cycle 
    ! Look at each disc error.
    de == disc error(j)
    if  printer lines=50 start 
      newpage
      printstring("EMAS ".ocps(ocptype,systype)." Disc Error Report Page:")
      write(printer page,1)
      printer page=printer page+1
      printer lines=0
      newlines(2)
      if  systype=P series start 
         printstring("  DATE     TIME    UNIT   MEDIA  ROUTE  STATI")
         printstring("STICS    STREAM---RESPONSE   CONTROLR  STREAM")
         printstring("  STATUS:             FAILED    SEEK INF")
         newline
         spaces(32)
         printstring(" P/T/S TRNSFRS/FAILS     0          1      ")
         printstring("STATUS   S0T0T1T2 T3T4T5T6 M0M1M2M3")
         printstring("  LBE       CCCCHHHHRR")
         newline
         printsymbol('-') for  i=1,1,132
      finishelsestart ; ! S series heading.
         printstring("  Date     Time    Unit  Media   Route    TCB      Device Status")
         spaces(39); printstring("Failed   Seek info")
         newline; spaces(32)
         printstring("DCU/SS  Response  S0T1T2T3 T4T5T6T7 T8T9TA ")
         printstring(" M0M1  M2M3M4M5  M6M7M8M9    TCB     CCCCHHHHSS")
         printsymbol('-') for  i=1,1,121
      finish 
      newlines(2)
    finish 
    printstring(de_date." ".de_time)
    printstring("  ".de_dev."  ".de_media)
    if  de_ertype="???" then  c 
     printstring("  ******Record lost******") else  start 
      printstring("  ".de_route)
      if  systype=P series start 
         st=de_tcount."/".de_fcount
         spaces(14-length(st))
         printstring(st)
         spaces(2)
         printstring(de_stream0."  ".de_stream1)
         printstring("  ".de_cstatus." ")
         if  de_ertype="BDS" then  printstring("?") else  printstring(" ")
         printstring(de_s0t2)
         printstring(" ".de_t3t6." ".de_m0m3)
         printstring("  ".de_faillbe."  ")
         printstring(de_cyl inf)
      finishelsestart ; ! S series.
         printstring("  ".de_tcb response."  ")
         printstring(de_s0t3." ".de_t4t7." ".de_t8ta)
         printstring("   ".de_m0m1."   ".de_m2m5."   ".de_m6m9)
         printstring("  ".de_fail tcb." ".de_cyl inf)
      finish 
    finish 
    newline
    printer lines=printer lines+1
  repeat 
  newpage
  select output(0)
  close stream(printer stream)
  deliver(icl dlv)
  send("JLP,.".lpdev)
  deliver(j dlv)
  end ;  !OF ROUTINE PRINTER DISC

!***********************************************************************
!ROUTINE TO TRANSLATE THE GIVEN SMAC ERROR FOR ALL SMAC/PROCESSOR TYPES.
!***********************************************************************
  routine  translate smac error(integer  i)
  !HERE THE ROUTINE TAKES THE SUPPLIED INFORMATION AND TRANSLATES
  !IT FOR THE ENGINEERS.
  switch  ocp(0:15)
  integer  j,int,count,d bit,d byte,d word,substatus
  board=0
  dilic=""
  platter="   "
  unit="  "
  return  unless  0<=ocptype<=15
  ->ocp(ocptype)

ocp(0):
ocp(1): return 
ocp(2):
ocp(3):
  !CODE FOR THE P3 SMAC.
  !RELEVANT TO 2970(1/4/16K CHIPS) ,2972(16K) ,2982(16K) ,2960(1/4K)
  hex to bin(smac error(i)_pointer,ptr)
  ptr=ptr>>25
  hex to bin(smac error(i)_address,saddr)
  smac=(saddr<<6)>>28
  hex to bin(smac error(i)_config,conf)
  if  chip type=-1 start 
    !RETURN WITH CHIP TYPE ONLY.
    chip type=(conf<<7)>>31
    return 
  finish 
  if  conf=0 then  dilic="" and  return 
  chip type=(conf<<7)>>31
  hex to bin(smac error(i)_status,status)
  substatus=status&p3 smac error mask
  translation(1)=""; tline=0
  if  status=previous status then  ->p3 skip tran
  tline=1; int=1
  for  j=1,1,24 cycle 
    if  substatus&int#0 start 
      if  length(translation(tline))+length(p3 smac fail(j))>60 c 
      start 
        tline=tline+1
        if  tline>2 then  translation(2)=translation(2)."...etc." c 
          and  exit 
        translation(tline)=""
      finish 
      translation(tline)=translation(tline)." / " unless  c 
          translation(tline)=""
      translation(tline)=translation(tline).p3 smac fail(j)
    finish 
    int=int<<1
  repeat 
  if  tline<3 start 
    substatus=status&p3 smac info mask
    int=1
    for  j=1,1,24 cycle 
      if  substatus &int#0 start 
        if  length(translation(tline))+length(p3 smac fail(j))>60 c 
        start 
          tline=tline+1
          if  tline>2 then  translation(2)=translation(2)."...etc." c 
          and  exit 
          translation(tline)=""
        finish 
        translation(tline)=translation(tline)." / " unless  c 
          translation(tline)=""
        translation(tline)=translation(tline).p3 smac fail(j)
      finish 
      int=int<<1
    repeat 
  finish 
  tline=2 if  tline>2
  previous status=status
p3 skip tran:
  if  status & p3 postmultisingle bit mask=0 then  return 
  if  ocptype=2 and  chip type=0 start 
    !2960 PROCESSOR WITH 1/4K CHIPS.
    sblock=(saddr<<11)>>28
    sub block=(saddr<<15)>>31
    col=(saddr<<16)>>29
    dilic="???"
    return  if  ptr>72
    data=ham p3 smac(ptr)
    pos=0
    if  63<data<68 then  pos=6 and  board=data-61
    if  67<data<72 then  pos=6 and  board=data-59
    if  pos=0 start 
      if  data>=32 then  data=data-32 and  board=6 else  board=0
      pos=(data//6)+1
      board=(board+1+data-(data//6)*6)
    finish 
    if  (sblock//2)*2=sblock then  board=(board*2)+1 c 
      else  board=board*2
    bit=(pos-1)*8 + t col(col)
    if  sub block=1 then  bit=bit+48
    dilic=" ".intostr(bit)
    if  length(dilic)=2 then  dilic=" ".dilic
    return 
  finish 
  !OTHERWISE WE HAVE A 2970(1/4/16K CHIP),2972(16 K) ,2960(16K),2982(16K)SITUATION
  if  chip type=1 start 
    !IE 16K CHIPS.
    pos=0; module=0
    if  ptr>71 then  dilic="???" and  return 
    data=ham p3 smac(ptr)
    module=(saddr<<10)>>29
    row=(saddr<<13)>>30
    if  0<=data<24 start 
      pos=0
      if  11<data then  bit=data-12 else  bit=data+12
    finish 
    if  23<data<44 start 
      pos=1
      if  31<data then  bit=data-32
      if  data<32 then  bit=data-12
    finish 
    if  63<data<68 start 
      pos=1
      bit=data-44
    finish 
    if  43<data<64 start 
      pos=2
      if  55<data then  bit=data-56
      if  data<56 then  bit=data-32
    finish 
    if  67<data<72 start 
      pos=2
      bit=data-60
    finish 
    pos=(2+(pos*8)+module)
    dilic=dilic t032((bit*4)+row)
    hex to bin(smac error(i)_eng state,hwsmac)
    hwsmac=(hwsmac<<8)>>28
    return 
  finish 
  if  chip type=0 start 
    !1 K AND 4 K CHIPS.
    if  ptr>72 then  dilic="???" and  return 
    sblock=(saddr<<11)>>28
    col=(saddr<<15)>>28
    blk 1 in bu=(conf&x'02')>>1
    blk 0 in bu=conf&x'01'
    data=ham p3 smac(ptr)
    if  (sblock=0 and  blk 0 in bu=1) or  c 
    (sblock=1 and  blk 1 in bu=1) start 
      !WE ARE DEALING WITH STORE IN BASIC UNIT.
      unit="BU"
      if  sblock=0 then  board=bu 0 2970(data) else  c 
      board=bu 1 2970(data)
    finish  else  start 
      !DEALING WITH STORE IN ADDITIONAL UNIT
      unit="AU"
      if  (sblock//2)*2=sblock then  board=au even 2970(data) c 
      else  board=au odd 2970(data)
    finish 
    if  data>=64 then  bit=5 else  start 
      if  data>31 then  data=data-32
      bit=data//6
    finish 
    dilic=dilic 8049((bit*16)+col)
  finish 
  return 

ocp(4):
  !P4 SMAC WITH 1K/4K CHIPS(2980)
  if  chip type=-1 then  chip type=0 and  return 
  !ASSUME NO 16K CHIPS ON P4 SMAC(2980)
  hex to bin(smac error(i)_pointer,ptr)
  hex to bin(smac error(i)_address,saddr)
  hex to bin(smac error(i)_config,conf)
  hex to bin(smac error(i)_status,status)
  substatus=status&p4 smac error mask
  translation(1)=""; tline=0
  if  status=previous status then  ->p4 skip tran
  tline=1; int=1
  for  j=1,1,24 cycle 
    if  substatus&int#0 start 
      if  length(translation(tline))+length(p4 smac fail(j))>60 c 
      start 
        tline=tline+1
        if  tline>2 then  translation(2)=translation(2)."...etc." c 
          and  exit 
        translation(tline)=""
      finish 
      translation(tline)=translation(tline)." / " unless  c 
          translation(tline)=""
      translation(tline)=translation(tline).p4 smac fail(j)
    finish 
    int=int<<1
  repeat 
  if  tline<3 start 
    substatus=status&p4 smac info mask
    int=1
    for  j=1,1,24 cycle 
      if  substatus &int#0 start 
        if  length(translation(tline))+length(p4 smac fail(j))>60 c 
        start 
          tline=tline+1
          if  tline>2 then  translation(2)=translation(2)."...etc." c 
          and  exit 
          translation(tline)=""
        finish 
        translation(tline)=translation(tline)." / " unless  c 
          translation(tline)=""
        translation(tline)=translation(tline).p4 smac fail(j)
      finish 
      int=int<<1
    repeat 
  finish 
  tline=2 if  tline>2
  previous status=status
p4 skip tran:
  if  status & p4 single bit mask=0 then  return 
  d bit=ptr>>24
  d byte=(ptr<<8)>>28
  d word=(ptr<<12)>>28
  int=ptr>>16
  count=0
  ptr=1
  for  j=0,1,15 cycle 
    if  int&ptr#0 then  count=count+1
    ptr=ptr<<1
  repeat 
  word=0;ptr=1
  for  j=0,1,3 cycle 
    if  d word&ptr#0 then  word =word+(3-j) and  exit 
    ptr=ptr<<1
  repeat 
  byte=0; ptr=1
  for  j=0,1,3 cycle 
    if  dbyte&ptr#0 then  byte=byte+(3-j) and  exit 
    ptr=ptr<<1
  repeat 
  bit=0; ptr=1
  for  j=0,1,7 cycle 
    if  dbit&ptr#0 then  bit=bit+(7-j) and  exit 
    ptr=ptr<<1
  repeat 
  sblock=(saddr<<10)>>28
  blk 1 in bu=(conf<<2)>>31
  blk 0 in bu=(conf<<1)>>31
  if  (count=3 and  dbit#0 and  dbyte#0 and  dword#0) start 
    !WE HAVE A SINGLE BIT FAILURE.
    !FOR THE MOMENT ASSUME 1 OR 4K CHIPS
    chip type=0
    data=byte<<3+bit
    bit=data//6; col=data-(6*bit)
    if  sblock=0 and  blk 0 in bu=1 start 
      unit="BU"
      if  word<2 then  board=bu 0 2980 w01(col) c 
      else  board=bu 0 2980 w23(col)
      if  word=1 or  word=3 then  platter="3" else  platter="2"
      if  word=2 or  word=3 then  platter=" 1".platter else  c 
        platter=" 2".platter
      ->dlc4
    finish 
    if  sblock=1 and  blk 1 in bu=1 start 
      unit="BU"
      if  word<2 then  board=bu 1 2980 w01(col) c 
      else  board=bu 1 2980 w23(col)
      if  word=1 or  word=3 then  platter="3" else  platter="2"
      if  word=2 or  word=3 then  platter=" 1".platter else  c 
        platter=" 2".platter
      ->dlc4
    finish 
    if  (sblock//2)*2=sblock start 
      if  word<2 then  board=au even 2980 w01(col) c 
      else  board=au even 2980 w23(col)
    finish  else  start 
      if  word<2 then  board=au odd 2980 w01(col) c 
      else  board=au odd 2980 w23(col)
    finish 
   unit="AU"
    if  word=1 or  word=3 then  platter="LOW" else  platter="UPP"
    dlc4:
    col=(saddr<<14)>>28
    dilic=dilic 8049((bit*16)+col)
    return 
  finish 
  if  count=1 start 
    !PARITY ERROR.
    unit="BU"
    sblock=0
    if  d bit#0 start 
      if  bit<4 then  word=2 else  word=3 and  bit=bit-4
    finish 
    if  d byte#0 then  word=1
    if  d word#0 then  word=0
    col=(2+bit)
    bit=5
    if  word<2 then  board=bu 0 2980 w01(col) else  c 
      board=bu 0 2980 w23(col)
    if  word=1 or  word=3 then  platter="3" else  platter="2"
    if  word=2 or  word=3 then  platter=" 1".platter else  c 
      platter=" 2".platter
    col=(saddr<<14)>>28
    dilic=dilic 8049((bit*16)+col)
    return 
  finish 
  dilic="???"; !IT MUST BE A STRANGE FAILURE.
  return 
ocp(5):
ocp(6):
  !P3 SMAC AND 16K CHIPS BASIC ON THE 2972.
  ->ocp(3)
ocp(7):
ocp(8):
ocp(9):
ocp(10):
ocp(11):
ocp(12):
ocp(13):
ocp(14):
ocp(15):
  return 
 end ;  !OF ROUTINE TRANSLATE SMAC ERROR.

!*****************************************************************
!A REPORT ON SMAC ERRORS TO BE PRINTED ON THE ENGINEER'S TERMINAL.
!*****************************************************************
  routine  terminal smac

  integer  i, j, k
  record (f smac error)name  sei
  connect(smacfile,0,0,0,r,flag)
  if  flag#0 start 
    printstring("Smac error report lost, sorry")
    newlines(2)
    return 
  finish 
  smac error==array(r_conad+x'40',af smac error)
  errors=integer(r_conad+x'1C')
  if  errors=0 start 
    printstring("No smac errors recorded.")
    newlines(2)
    return 
  finish 
  i=1
  chip type=-1; translate smac error(i)
  for  i=1,1,errors cycle 
    continue  unless  spdev="ALL" or  spdev=sei_smac
    sei == smac error(i)
    if  outlines>=terminal lines start 
      if  out lines=terminal lines start 
        cycle 
          prompt("CONTINUE:")
          read prompt reply(st)
          exit  if  res str(st,"Y",ss)=yes or  res str(st,"N",ss)=yes
        repeat 
        if  res str(st,"N",ss)=yes start 
          printstring("Summary terminated")
          newline
          return 
        finish 
      finish 
      newpage
      printstring("DT TIME SMAC ADDRESS   PARITY ")
      printstring("  STATUS   CONFIG SEIPARAM  ")
      if  chip type=0 then  printstring("BLK BD PLT DLC") else  c 
        printstring("MOD POS DLC NS")
      newline
      printsymbol('-') for  j=1,1,72
      newlines(2)
      out lines=4
      previous status=0
    finish 
    translate smac error(i)
    st=sei_date; length(st)=length(st)-6
    st=st." ".sei_time;length(st)=length(st)-3
    st=st."  ".sei_smac
    st=st." ".sei_address
    st=st." ".sei_pointer." "
    st=st.sei_status." ".sei_config." "
    st=st.sei_sei param
    printstring(st)
    if  dilic#"" start 
      if  chip type=0 start 
        write(sblock,2); printstring(unit);write(board,2)
        printstring(" ".platter); printstring(" ".dilic)
      finish  else  start 
        !16K CHIPS
        write(module,3); write(pos,3)
        printstring("  ".dilic."  ".tohex(hwsmac))
      finish 
    finish 
    newline
    out lines=out lines+1
    for  k=1,1,tline cycle 
      spaces(8)
      printstring(translation(k)); newline
      outlines=outlines+1
    repeat 
    outlines = terminal lines if  outlines>terminal lines
  repeat 
  printstring("Summary completed")
  newline
  end ;  !OF ROUTINE TERMINAL SMAC

!*******************************************************
!A REPORT ON SMAC ERRORS TO BE SENT TO THE LINE PRINTER.
!*******************************************************
  routine  printer smac
  integer  i, k
  record (f smac error)name  sei
  connect(smacfile,0,0,0,r,flag)
  if  flag#0 start 
    printstring("Smac error report lost,  sorry!")
    newline
    return 
  finish 
  smac error==array(r_conad+x'40',af smac error)
  errors=integer(r_conad+x'1C')
  if  errors=0 start 
    select output(0)
    printstring("No smac errors recorded.")
    newline
    return 
  finish 
  define("STREAM".intostr(printer stream).",JLP")
  select output(printer stream)
  printer lines=50
  printer page=1
  i=1
  chip type=-1; translate smac error(i)
  for  i=1,1,errors cycle 
    sei == smac error(i)
    if  printer lines>=50 start 
      newpage
      printstring("EMAS ".ocps(ocptype,systype)." SMAC error")
      printstring("          Page: ")
      write(printer page,3)
      printer page=printer page+1
      printer lines=0
      newline
      printstring("   DATE      TIME      SMAC    PARITY ")
      printstring("  ADDRESS   ENG STATE  STATUS    CONFIG")
      printstring("   SEI PARAM   DATA")
      spaces(11)
      if  chip type=0 then  printstring("BLOCK BRD PLAT DILIC") else  c 
        printstring("MODULE POSITN DILIC NSMAC")
      newline
      printsymbol('-') for  k=1,1,131
      newlines(2)
      previous status=0
    finish 
    translate smac error(i)
    spaces(1)
    printstring(sei_date."  ".sei_time)
    spaces(5)
    printstring(sei_smac."     ".sei_pointer)
    printstring("  ".sei_address."  ")
    printstring(sei_eng state."  ")
    printstring(sei_status."  ".sei_config)
    printstring("  ".sei_sei param)
    printstring("  ".sei_data)
    if  dilic#"" start 
      if  chip type=0 start 
        write(sblock,3)
        printstring(unit); write(board,3)
        printstring("  ".platter."   ".dilic)
      finish  else  start 
        write(module,5)
        write(pos,6); printstring("   ".dilic."   ".tohex(hwsmac))
      finish 
    finish 
    newline
    for  k=1,1,tline cycle 
      spaces(30)
      printstring(translation(k))
      newline
      printer lines=printer lines+1
    repeat 
    newline
    printer lines=printer lines+2
  repeat 
  newpage
  select output(0)
  close stream(printer stream)
  deliver(icl dlv)
  send("JLP,.".lpdev)
  deliver(j dlv)
  end ;  !OF ROUTINE PRINTER SMAC

!****************************************************
!A REPORT OF DRUM ERRORS TO BE GIVEN ON THE TERMINAL.
!****************************************************
  routine  terminal drum
  integer  srnh, i, j
  record (f drum error)name  dei
  outlines=-1
  connect(drumfile,0,0,0,r,flag)
  if  flag#0 start 
    printstring("Drum error report lost, sorry")
    newline
    return 
  finish 
  errors=integer(r_conad+x'1C')
  if  errors=0 start 
    printstring("No drum errors recorded.")
    newline
    return 
  finish 
  drum error==array(r_conad+x'40',af drum error)
  for  i=1,1,errors cycle 
    continue  unless  spdev="ALL" or  spdev=drum error(i)_route
    dei == drum error(i)
    if  out lines>terminal lines-epage or  outlines=-1 start 
      if  outlines#-1 start 
        cycle 
          prompt("CONTINUE:")
          read prompt reply(st)
          exit  if  res str(st,"Y",ss)=yes or  res str(st,"N",ss)=yes
        repeat 
        if  res str(st,"N",ss)=yes start 
          printstring("Summary terminated.")
          newline
          return 
        finish 
      finish 
      newpage
      printstring("DATE  TIME  ROUTE ERR  STREAM 0 STREAM 1 STREAM 2")
      printstring(" STREAM 3 STREAM 4     "); newline
      printsymbol('-') for  j=1,1,67
      newline
      out lines=3
    finish 
    st=dei_date; length(st)=length(st)-3
    st=st." ".dei_time; length(st)=length(st)-3
    st=st." ".dei_route." "
    st=st.dei_ertype
    srnh=0
    for  j=1,1,epage cycle 
      if  dei_drum sector(j)_word1="00040008" then  c 
      srnh=1 else  start 
        if  dei_drum sector(j)_word1#"00800000" then  c 
          srnh=0 and  exit 
      finish 
    repeat 
    if  srnh=1 start 
      printstring(st."   Service request not honoured.")
      newline
      outlines=outlines+1
    finish  else  start 
      for  j=0,1,4 cycle 
        st=st." ".dei_stream(j)
      repeat 
      printstring(st)
      for  j=1,1,epage cycle 
        newline
        spaces(12); printstring("Sector: ")
        printstring(dei_drum sector(j)_word1)
        printstring(" ".dei_drum sector(j)_word2)
        printstring(" ".dei_drum sector(j)_desc)
      repeat 
      newlines(2)
      out lines=out lines+epage+2
    finish 
  repeat 
  printstring("Summary completed.")
  newline
  return 
  end ;  !OF ROUTINE TERMINAL DRUM

!**************************************************
!A REPORT OF DRUM ERRORS TO BE SENT TO THE PRINTER.
!**************************************************
  routine  printer drum
  integer  i, j
  record (f drum error)name  dej
  connect(drumfile,0,0,0,r,flag)
  if  flag#0 start 
    printstring("Drum error report lost,  sorry!")
    newline
    return 
  finish 
  drum error==array(r_conad+x'40',af drum error)
  errors=integer(r_conad+x'1C')
  if  errors=0 start 
    printstring("No drum errors recorded")
    newline
    return 
  finish 
  define("STREAM".intostr(printer stream).",JLP")
  select output(printer stream)
  printer lines=57
  printer page=1
  for  j=1,1,errors cycle 
    dej == drum error(j)
    if  printer lines>=56 start 
      newpage
      printstring("EMAS ".ocps(ocptype,systype)." Drum error report page:")
      write(printer page,3)
      printer page=printer page+1
      printer lines=0
      newlines(2)
      spaces(19)
      printstring("Port/"); SPACES(55)
      printstring("SECTOR DESCRIPTION (one per 1 K byte sector)")
      newline
      spaces(19)
      printstring("Trunk/   Err   Controller status")
      printsymbol('-') for  i=1,1,27
      printstring(" -Stream response-"); newline
      printstring("  Date     Time    Mechnsm  Type   Word 0")
      printstring("   Word 1   Word 2   Word 3   Word 4   ")
      printstring("Word 0   Word 1   Breakdown")
      newline
      printsymbol('-') for  i=1,1,130
      newlines(2)
    finish 
    spaces(1)
    if  dej_ertype="??" start 
      printstring("********Record lost*********")
      printer lines=printer lines+2
    finish  else  start 
      printstring(dej_date." ".dej_time)
      spaces(9-length(dej_route))
      printstring(dej_route."  ".dej_ertype)
      for  i=0,1,4 cycle 
        printstring(" ".dej_stream(i))
      repeat 
      for  i=1,1,epage cycle 
        if  i#1 then  newline and  spaces(78)
        printstring(" ".dej_drum sector(i)_word1)
        printstring(" ".dej_drum sector(i)_word2)
        printstring(" ".dej_drum sector(i)_desc)
      repeat 
      printer lines=printer lines+epage+2
    finish 
    newlines(2)
  repeat 
  newpage
  select output(0)
  close stream(printer stream)
  deliver(icl dlv)
  send("JLP,.".lpdev)
  deliver(j dlv)
  end ;  !OF ROUTINE PRINTER DRUM

  end ;  !OF EXTERNAL ROUTINE JEF

! ***********************************************
! ***********************************************
  externalroutine  jefrecall(string (255) st)
  st="ENGCALL"
  journal analysis(st)
  end ;  !OF EXTERNAL ROUTINE MAINLOG SUMMARY


!***********************************************
!***************************************************
!***************************************************
  externalroutine  update jef(string (255) st)
    st="EXTERNAL,OVERRIDE"
    journal(st)
  end 


! ******************************************************
! ******************************************************
! ******************************************************
  externalroutine  tape library(string (255) s)
  routinespec  s newpage
  routinespec  s dots(integer  i)
  routinespec  s spaces(integer  n)
  routinespec  s printstring(string (72) s)
  routinespec  s newlines(integer  n)
  routinespec  s write(integer  i,j)
  routinespec  s print(integer  i,j, real  r)
  constinteger  max terminal lines = 18
  constinteger  max printer lines = 60
  constinteger  on = 1
  constinteger  off = 0
  owninteger  terminal = off
  owninteger  printer = off
  owninteger  t print,p print
  owninteger  terminal lines
  owninteger  printer lines
  owninteger  terminal page = 1
  owninteger  printer page = 1
  integerarray  sq(1:1000)
  !ARRAY USED IN SORT
  record  (rf)r
  !FORMAT DECLARATIONS.
  recordformat  f deck(integer  read rcvrd,read unrcvrd,rrtot,
          write rcvrd,write unrcvrd,wrtot,mounts)
  recordformat  f tape lib(string (6) tsn, byteinteger  spare,
          integer  date,record (f deck)array  deck(1:20))
  record (f tape lib)arrayformat  af tape lib(1:1000)
  record (f tape lib)arrayname  tape lib
  recordformat  f deck identity(integer  date,string (3) id)
  record (f deck identity)arrayformat  af deck identity(1:20)
  record (f deck identity)arrayname  deck identity
  integername  tl rec count
  integer  tl addr,i,j,k,flag,start,ocptype,systype
  real  rl
  string (32) ss,s1,st,tape


  routine  continue
  integer  flag
    string (16) s1,s2
    prompt("Continue:")
    cycle 
      read prompt reply(s1)
      return  if  res str(s1,"Y",s2)=yes
      exit  if  res str(s1,"N",s2)=yes
    repeat 
    select output(0)
    if  printer=on start 
      printstring("Do you wish the printer report completed?")
      newline
      prompt("YES OR NO:")
      cycle 
        read prompt reply(s1)
        exit  if  res str(s1,"Y",s2)=yes or  res str(s1,"N",s2)=yes
      repeat 
      if  res str(s1,"Y",s2)=yes start 
        terminal = off; t print=off; terminal lines = 0
        printstring("Journal:  terminal report ended, completing ")
        printstring("printer report.")
        newline
        return 
      finish 
    finish 
    printstring("Journal:  run abandoned  as requested.")
    newline
    if  printer=on start 
      close stream(1)
      destroy("JTAPELIBL",flag)
    finish 
    stop 
  end ;  !OF CONTINUE

  if  s#"*" start 
    printstring("Define the required function.")
    newline
    cycle 
      prompt("AMEND/REPORT:")
      read prompt reply(st)
      exit  if  res str(st,"A",ss)=yes or  res str(st,"R",ss)=yes
    repeat 
    define("STREAM01,CRAPOUT")
    if  res str(st,"A",ss)=yes start 
      !THE USER WISHES TO CHANGE CERTAIN REPORT ENTRIES.
      printstring("Now define amendment required.")
      newline
      cycle 
        prompt("DECK/TAPE/ALL:")
        read prompt reply(st)
        exit  if  st="ALL" or  st="DECK" or  st="TAPE"
      repeat 
      if  st="DECK" start 
        cycle 
          prompt("DECK IDENTITY:")
          read prompt reply(s1)
          exit  if  length(s1)=3 and  res str(s1,"M",ss)=yes
        repeat 
      finish 
      if  st="TAPE" start 
        cycle 
          prompt("TSN:")
          read prompt reply(s1)
          exit  if  length(s1)=6
        repeat 
      finish 
      if  st="ALL" start 
        modpdfile(2,"JENGPD","JTAPELIB","",flag)
        if  flag#0 start 
          printstring("Journal:  failed to clear down library!!")
          newlines(2)
          return 
        finish 
        printstring("Journal:  tape library cleared.")
        newlines(2)
        return 
      finish 
      select output(1)

      copy("JENGPD_JTAPELIB,JTAPELIB")
      select output(0)

      connect("JTAPELIB",3,0,0,r,flag)
      if  flag#0 start 
        printstring("Journal:  cannot connect library file, flag=")
        printstring(intostr(flag))
        newlines(2)
        destroy("JTAPELIB",flag)
        return 
      finish 
      tape lib==array(r_conad+x'100',af tape lib)
      deck identity==array(r_conad+x'30',af deck identity)
      tl rec count==integer(r_conad+x'20')
      if  tl rec count=0 start 
        printstring("Journal:  tape library empty!!")
        newlines(2)
        disconnect("JTAPELIB",flag)
        destroy("JTAPELIB",flag)
        return 
      finish 
      if  st="DECK" start 
        for  i=1,1,20 cycle 
          if  deck identity(i)_id=s1 then  exit 
          if  i=20 start 
            printstring("Journal:  deck not found!")
            newlines(2)
            disconnect("JTAPELIB",flag); destroy("JTAPELIB",flag)
            return 
          finish 
        repeat 
        if  deck identity(i)_date=0 start 
          printstring("Journal:  deck already cleared down.")
          newlines(2)
          return 
        finish 
        deck identity(i)_date=0
        tape lib(j)_deck(i) = 0 for  j=1,1,tl rec count
        disconnect("JTAPELIB",flag)
        select output(1)
        copy("JTAPELIB,JENGPD_JTAPELIB")
        select output(0)

        printstring("Journal:  deck ".S1." cleared down ok.")
        newlines(2)
        destroy("JTAPELIB",flag)
        return 
      finish 
      if  st="TAPE" start 
        for  i=1,1,tl rec count cycle 
          if  tape lib(i)_tsn=s1 start 
            if  tape lib(i)_date=0 start 
              printstring("Journal:  tape already cleared.")
              newlines(2)
              disconnect("JTAPELIB",flag); destroy("JTAPELIB",flag)
              return 
            finish 
            tape lib(i)_date=0
            tape lib(i)_deck(j) = 0 for  j = 1,1,20
            disconnect("JTAPELIB",flag)
            select output(1)
            copy("JTAPELIB,JENGPD_JTAPELIB"); destroy("JTAPELIB",flag)
            select output(0)
            printstring("Journal:  tape ".S1." cleared down ok.")
            newlines(2); return 
          finish 
        repeat 
        printstring("Journal:  tape not found."); NEWLINES(2)
        disconnect("JTAPELIB",flag)
        destroy("JTAPELIB",flag)
        return 
      finish 
    finish 
    !ELSE A REPORT IS REQUIRED.
    !UNLESS AUTO REPORT REQUESTED ASK FOR REPORT DESTINATION.
    printstring("Terminal, printer or both")
    newline
    cycle 
      prompt("WHERE:")
      read prompt reply(st)
      exit  if  res str(st,"T",ss)=yes or  res str(st,"P",ss)=yes  or  res str(st,"B",ss)=yes
    repeat 
    if  res str(st,"T",ss)=yes then  terminal = on
    if  res str(st,"P",ss)=yes then  printer = on
    if  res str(st,"B",ss)=yes then  terminal = on and  printer = on
  finish  else  printer = on
  connect("JENGPD_JTAPELIB",0,0,0,r,flag)
  if  flag#0 start 
    select output(0)
    printstring("Journal:  tape library file not available!!")
    newline; printstring("         flag=".INTOSTR(FLAG))
    newline
    return 
  finish 
  tl addr=r_conad+x'20'
  tape lib==array(tl addr+x'E0',af tape lib)
  deck identity==array(tl addr+x'10',af deck identity)
  tl rec count==integer(tl addr)
  if  tl rec count=0 start 
    select output(0)
    printstring("Journal:  no tape statistics available.")
    newline
    return 
  finish 
  connect("JENGPD_JENGHD",0,0,0,r,flag)
  if  flag#0 start 
    printstring("Cannot determine ocptype.  P series assumed.")
    newline
    ocptype=0
    systype=0
  finish  else  start 
    systype=integer(r_conad+x'FC')
    ocptype=integer(r_conad+x'100')
  finish 

  !NOW MAKE THE REQUIRED REPORTS.

  p print=printer; t print=terminal;  !USED IN CONTROL OF 'S' ROUTINES.
  if  printer = on then  define("STREAM01,JTAPELIBL")
  printstring("Define the tapes you wish to look at."); NEWLINE
  printstring("Reply either 'ALL' or the tsn of the")
  printstring(" specific tape required.")
  newline
  cycle 
    prompt("Tape:")
    read prompt reply(tape)
    exit  if  tape="ALL" or  length(tape)<=6
  repeat 
  printstring("Define the decks you wish to look at.")
  newline
  printstring("Reply either 'ALL' or the identity of the specific")
  printstring(" deck required.")
  newline
  cycle 
    prompt("Deck:")
    read prompt reply(st)
    exit  if  st="ALL"
    exit  if  length(st)=3 and  res str(st,"M",ss)=yes
  repeat 
  s newpage
  if  s="*" start 
    !IE THIS IS THE AUTOMATIC WEEKLY REPORTING CALL.
    select output(1)
    printstring("*************************************************")
    printstring("* Monthly report to be retained.                *")
    printstring("*************************************************")
    newpage
  finish 
  sq(i)=i for  i=1,1,tl rec count
  !NOW DO THE SORT
  for  i=1,1,tl rec count cycle 
    for  j=i,1,tlrec count cycle 
      if  tape lib(sq(j))_tsn<tape lib(sq(i))_tsn start 
        k=sq(j);sq(j)=sq(i);sq(i)=k
      finish 
    repeat 
  repeat 
  start=0
  for  i=1,1,20 cycle 
    exit  if  deck identity(i)_id=""
    !IE THE END OF THE LIBRARY REPORTING.
    if  terminal = on then  terminal lines=max terminal lines+1
    if  printer = on then  printer lines =max printer lines+1
    terminal page=1; printer page=1
    if  (st="ALL" or  deck identity(i)_id="M".ss) and  c 
    deck identity(i)_date#0 start 
      !IE WE WANT A REPORT ON THIS DECK
      for  j=1,1,tl rec count cycle 
        if  tape lib(sq(j))_deck(i)_mounts>0 and  c 
        tape lib(sq(j))_date#0 start 
          !THERE IS SOMETHING FOR THIS TAPE ON THE DECK
          if  tape="ALL" or  tape=tape lib(sq(j))_tsn start 
            t print=off; p print=off
            if  terminal lines>max terminal lines then  t print=on
            if  printer lines>max printer lines then  p print=on
            if  t print+p print>0 start 
              !IE AT LEAST ONE REPORT REQUIRES A NEWPAGE/HEADING.
              if  t print=on start 
                continue unless  start=0
              start=1
            finish 

              s newpage
              sprintstring("EMAS ".ocps(ocptype,systype)." Journal system ")
              sprintstring("Tape library rep")
              sprintstring("ort for deck ".DECK IDENTITY(I)_ID."  Page")
              if  t print=on then  select output(0) and  c 
                write(terminalpage,3) and  terminal page=terminal page+1
              if  p print=on then  select output(1) and  c 
                write(printer page,3) and  printer page=printer page+1
              s newlines(1)
              s printstring("For the period: ")
              sprintstring(unpackdate(deck identity(i)_date))
              sprintstring("(".unpacktime(deck identity(i)_date).")")
              sprintstring(" to ".unpackdate(integer(tladdr+8)))
              sprintstring("(".unpacktime(integer(tladdr+8)).")")
              s newlines(1)
              s spaces(8); s printstring("Record   ")
              s spaces(8)
              s printstring("READ ERRORS----------  WRITE ERRORS---")
              sprintstring("------"); s newlines(1)
              s printstring("MEDIA   STARTS  MOUNTS   RCVRD(AV.LVL)")
              s printstring(" UNRCVRD  RCVRD(AV.LVL) UNRCVRD")
              s newlines(1)
              s printstring("-----------------------------------")
              s printstring("----------------------------------")
              s newlines(1)
              if  t print=on then  terminal lines=7
              if  p print=on then  printer lines=7
            finish 
            t print=terminal; p print=printer
            s printstring(tape lib(sq(j))_tsn)
            s spaces(7-length(tape lib(sq(j))_tsn))
            if  tape lib(sq(j))_date>deck identity(i)_date then  c 
            sprintstring(unpackdate(tapelib(sq(j))_date)) else  c 
            s printstring(unpackdate(deck identity(i)_date))
            s write(tape lib(sq(j))_deck(i)_mounts,5)
            if  tape lib(sq(j))_deck(i)_read rcvrd=0 then  sspaces(2) c 
            and  s dots(15) else  start 
              s spaces(2); s dots(2)
              s write(tape lib(sq(j))_deck(i)_read rcvrd,4)
              s printstring("(")
              rl=tapelib(sq(j))_deck(i)_rrtot
              rl=rl/tapelib(sq(j))_deck(i)_read rcvrd
              s print(2,1,rl)
              s printstring(" )")
            finish 
            if  tape lib(sq(j))_deck(i)_read unrcvrd=0 then  sdots(8) c 
            else  s write(tape lib(sq(j))_deck(i)_read unrcvrd,7)
            s dots(2)
            if  tapelib(sq(j))_deck(i)_write rcvrd=0 then  sdots(13) c 
            else  start 
              s write(tape lib(sq(j))_deck(i)_write rcvrd,4)
              s printstring("(")
              rl=tapelib(sq(j))_deck(i)_wrtot
              rl=rl/tapelib(sq(j))_deck(i)_write rcvrd
              s print(2,1,rl)
              s printstring(" )")
            finish 
            if  tapelib(sq(j))_deck(i)_write unrcvrd=0 then  sdots(8) c 
            else  s write(tape lib(sq(j))_deck(i)_write unrcvrd,7)
            s newlines(1)
          finish 
        finish 
      repeat 
    finish 
  repeat 
  if  printer = on start 
    select output(0)
    close stream(1)
    send("JTAPELIBL,.LP")
  finish 

!THE S ROUTINES.

  routine  s dots(integer  n)
    integer  i
    if  t print = on start 
      select output(0)
      printsymbol('.') for  i=1,1,n
    finish 
    if  p print = on start 
      select output(1)
      printsymbol('.') for  i=1,1,n
    finish 
  end ; !OF ROUTINE S DOTS.

  routine  s spaces(integer  n)
    if  t print=on then  select output(0) and  spaces(n)
    if  p print=on then  select output(1) and  spaces(n)
  end ;  !OF S SPACES

  routine  s newpage
    if  t print=on then  select output(0) and  newpage
    if  p print=on then  select output(1) and  newpage
  end ;  !OF S NEWPAGE

  routine  s printstring(string (72) s)
    if  t print=on then  select output(0) and  printstring(s)
    if  p print=on then  select output(1) and  printstring(s)
  end ;  !OF S PRINTSTRING

  routine  s newlines(integer  n)
    if  t print=on start 
    select output(0)
    newlines(n)
    terminal lines=terminal lines+n
    finish 
    if  p print=on start 
      select output(1)
      newlines(n)
      printer lines=printer lines+n
    finish 
  end ;  !OF S NEWLINES

  routine  s write(integer  i,j)
    if  t print=on then  select output(0) and  write(i,j)
    if  p print=on then  select output(1) and  write(i,j)
  end ;  !OF S WRITE

  routine  s print(integer  i,j, real  r)
    if  t print=on then  select output(0) and  print(r,i,j)
    if  p print=on then  select output(1) and  print(r,i,j)
  end ;  !OF S PRINT

  end ;  !OF ROUTINE TAPE LIBRARY REPORT

  externalroutine  t l(string (255) s)
  tape library(s)
  end ;  !OF ROUTINE TL.

  integerfn  res str(string (255) a, string (255) b, string (*)name  c)
     ! This function carries out the IMP9 resolution
     !       a -> (b).c
     ! if it can and returns the result yes (i.e. 1).  If it cannot carry
     ! out the resolution it returns the result no (i.e.), having left
     ! c unchanged.
  
     string (255) s1, s2
     if  a -> s1.(b).s2 and  s1="" start 
        c = s2
        result  = yes
     finishelse  result  = no
  end ; ! Of %integerfn res str.

endoffile