!FILE LAST CHANGED ON 08/03/83
!  *******************************************************************
!  *                                                                 *
!  *    THE JOURNAL SYSTEM:    PACKAGE B                             *
!  *    THIS PACKAGE IS THE ANALYSIS SECTION OF THE EMAS 2900        *
!  *    JOURNAL SYSTEM.                                              *
!  *                                                                 *
!  *    DESIGNED AND WRITTEN BY JOHN HENSHALL.                       *
!  *                                                                 *
!  *    Updated 6/10/81 by Roy Middleton to auto analyse NETLOG.     *
!  *                                                                 *
!  *    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  change file size(string (31)file,
          integer  newsize , integername  flag)
  systemroutinespec  destroy(string (31) s, integername  flag)
  systemroutinespec  disconnect( string (31) file, integername  flag)
  systemroutinespec  newgen(string (31) s, t, integername  flag)
  systemroutinespec  offer(string (31) file, string (6) to,
          integername  flag)
  systemroutinespec  move(integer  l, f, t)
  systemroutinespec  outfile(string (31) s, integer  size, hole,
          protection, integername  conad, flag)
  systemroutinespec  uctranslate(integer  address, length)
  systemintegerfnspec  pack date and time(string (8) date, time)
  systemstringfnspec  unpack date(integer  packed)
  systemstringfnspec  unpack time(integer  packed)

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

  externalstringfnspec  uinfs(integer  entry)
  externalroutinespec  cherish(string (255) s)
  externalroutinespec  copy(string (255) s)
  externalroutinespec  rename(string (255) s)
  externalroutinespec  define(string (255) s)
  externalroutinespec  deliver(string (255) s)
  externalroutinespec  list(string (255) s)
  externalroutinespec  newpdfile(string (255) s)
  externalroutinespec  restore analysis(string (255) s)
  ! This routine is in package D.
  externalroutinespec  print help(integer  link)
  !LINKS INTO THE HELP INFORMATION PACKAGE  E.
  externalroutinespec  prompt(string (255) s)
  externalroutinespec  readmag(integer  chnl, addr, integername  len, flag)
  externalroutinespec  unload mag(integer  chnl)
  externalroutinespec  open mag(integer  chnl, string (7) tsn)
  externalroutinespec  f skip tm mag(integer  chnl, marks,
          integername  flag)
  externalstringfnspec  date
  externalroutinespec  send(string (255) s)
  externalstringfnspec  time
  externalroutinespec  read prompt reply(stringname  reply)
  externalroutinespec  read description(stringname  reply)
  externalintegerfnspec  s to i(string (255) s)
  externalintegerfnspec  cyclic(integer  from, direction)
  externalstringfnspec  intostr(integer  value)
  externalroutinespec  create jfile(string (11) name, integer  cells, cellsize,
      headersize, integername  conad, flag)
  externalroutinespec  expand jfile(string (11) file, integer  newsize,
                                    integername  conad, flag)

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

  routinespec  identify index(stringname  keyword, byteintegername  c 
          id char, data type, integername  entry)
  routinespec  journal analysis(string (255) s)
  routinespec  master file failure(stringname  file, integer  flag)

!**********RECORD FORMATS

  recordformat  f chapter header(string (6) tape name, user name,
          string (15) file name, string (8) date, time, type,
          byteinteger  spare0, spare1, spare2, integer  chapter, epages,
          fsys, perms)
  recordformat  f index entry(integer  file id, starting, finishing,
          chapter, string (6) tape, byteinteger  status)
  recordformat  f index list(byteinteger  id char,
          data type, string (12) identity)
  recordformat  f parameters(string (4) lower file, upper file,
          string (12) keyword, analysis)
  recordformat  pdhf(integer  dataend, datastart, size, filetype,
          sum, datetime, adir, count)
  recordformat  pdf(integer  start, string (11) name,
          integer  hole, s5, s6, s7)

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

  constinteger  block = 4096
  !BYTES IN EPAGE.
  constinteger  index top = 9999
  !THE PHYSICAL TOP OF AN INDEX.
  constinteger  system indices = 6
  !THE MAXIMUM NUMBER OF FILE SYSTEMS ON EMAS.
  !THE TOTAL NUMBER OF SYSTEM INDICES.
  constinteger  total indices = 20
  !MAXIMUM NUMBER OF INDICES ON THE SYSTEM.
  constantstring (9) jtxt="Journal: "
  ownstring (8) control="JJMASTER"
  !THE IDENTITY OF THE SYSTEM CONTROL FILE.
  conststring (8) pdstore="JJ#PD"
  !THE JOURNAL SYSTEM 24 HOUR STORAGE FILE.
  constinteger  max unit errors = 2000
  !LEVEL TO WHICH ANY MAINLOG ENGINEERING ANALYSIS WILL RECORD IN
  !FULL FOR A PARTICULAR DEVICE TYPE(IE DISC ERRORS) AFTER WHICH AN
  !INFORMATIVE MESSAGE WILL BE GIVEN TO THE ENGINEERS.
  ownstring (255) ns1, ns2; !USED IN STRING RESOLUTIONS.
  constinteger  no=0, yes=1
  constinteger  matched = yes
  constinteger  unmatched = no
  constinteger  sspdfiletype = 6

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

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

!    RETRIEVE: THE RETRIEVAL INTERFACE TO JOURNAL ANALYSIS.


!    JOURNAL ANALYSIS: THIS ROUTINE GIVES ALL THE ANALYSIS FUNCTIONS
!    OF THE SYSTEM SOME OF WHICH CAN ALSO BE CALLED AUTOMATICALLY
!    BY JOURNAL.


! ************************************************************************
! ************************************************************************
! ************************************************************************
  externalroutine  retrieve(string (255) s)
  journal analysis(s)
  end ;  !OF ROUTINE RETRIEVE.

! ************************************************************************
! ************************************************************************
! ************************************************************************
  externalroutine  journal analysis(string (255) s)
  conststring (32) array  common analyses(1:10)= c 
    "COMPLETE", "ON KEY", "", "", "", "", "", "", "", ""
  conststring (32) array  system analyses(1:10, 0:7)= c 
    "ENG RERUN", "ALL", "CONTROLLER", "DISC", "MANAGER STATS", ""(5),
    "VOLAUTOTEST", ""(9),
    "SPLRAUTOTEST", "BACKGROUND SUMMARY", ""(8),
    ""(10),
    "DIRECTAUTOTEST", ""(9),
    ""(10),
    ""(10),
    ""(10)
  conststring (20) icl dlv= c 
          "ICL_2900_ENGINEERS"
  conststring (20) own dlv= c 
          "JOURNAL-MANAGEMENT"
  integerarray  close list(0:20)
  close list(0)=0
  !ENTRY 'CLOSE LIST(0)' IS THE COUNT OF THE ANALYSES THAT REQUIRE
  !TIDYING UP AT THE RUN END. THE REMAINING ENTRIES ACT AS CODE LINKS
  !IN THE ROUTINE 'CLOSE ANALYSES'.
  owninteger  next stream = 11;  !KEEP TRACK OF THE USED OUTPUT STREAMS.
  owninteger  general stream;  !THE GENERAL PURPOSE OUTPUT STREAM.
  owninteger  current chapter=-1
  owninteger  tape unit=1
  owninteger  anal no=-1
  owninteger  link
  owninteger  engineer interaction
  owninteger  engineer special
  !THIS INDICATES WHETHER THE RUN OF ANALYSIS IS AN 'ENGINEER'S' RUN.
  owninteger  man facility=0
  !SET ON IF THE CALL IS FROM THE MANAGEMENT PACKAGE(D). THE PARAMS
  !FOR THE FIRST ANALYSIS BEING IN THE CALL
  string (32) man facility call
  owninteger  file action
  !USED IN DETERMINING WHAT ACTION TO
  !TAKE WITH A RETRIEVED FILE.
  owninteger  full run
  !USED TO DEFINE WHETHER AN ANALYSIS IS A COMPLETE AUTOMATIC RUN TO
  !INCLUDE ACCUMULATION DATA.
  !THESE LAST TWO ARE USED IN POINTING TO ANALYSIS CODE.
  constinteger  on=1
  constinteger  off=0
  constinteger  eng console lines=18
  !IE THE NUMBER OF LINES ON THE PAGE OF THE ENGINEERS CONSOLE.
  record (f index entry)arrayformat  af index entry(0:index top)
  record (f index entry)arrayname  index entry
  record (f parameters)name  parameters
  record (f chapter header)name  chapter header
  record  (rf)r
  routinespec  accounts analysis(integer  anal no, link)
  routinespec  close analyses
  routinespec  common analysis(integer  anal no, link)
  routinespec  initialise analysis(integer  link)
  routinespec  mainlog analysis(integer  anal no, link)
  routinespec  retrieve file(integer  i, dtfrom, dtto, integername  flag)
  routinespec  direct analysis(integer  anal no, link)
  routinespec  volums analysis(integer  anal no, link)
  routinespec  spoolr analysis(integer  anal no, link)
  routinespec  remove cell(integer  i)
  routinespec  reduce ijob
  integerfnspec  getcell(integer  close to)
  routinespec  extend cjob
  routinespec  print log line
  routinespec  get next line
  routinespec  resolve line
  routinespec  resolve next line;  !RESOLUTION TO WORDS WITHIN A LINE.
  integerfnspec  search(stringname  s)
  stringfnspec  makest(integer  word)
  integerfnspec  compare st(integer  word, string (32) st)
  byteintegerarray  buffer(0:4095)
  integer  low file, high file, entry, dtfrom, dtto, bottom file, posn
  integer  ii, i, j, k, l, base, flag, words, word count, line, conad
  integer  winteger, log start, log finish, endflag, section, top file
  byteintegerarray  stl(0:127)
  integerarray  st addr(0:127)
  string (12) tape up, keyword, analysis, ddate, dtime, filename
  string (32) reply, index, tempfile, wstring, wstring1, ss, delivery
  string (15) print device; print device = ""
  string (6) offer to
  delivery=own dlv
  tape up="";  !INITIAL VALUE OF THE MOUNTED TAPE.
  byteinteger  id char, data type
  !ID CHAR: DEFINES THE INDEX TYPE FOR THIS FILE ANALYSIS
  !DATA TYPE: DEFINES IF THE FILE IS TEXT(DATA TEXT) (0)  OR MAPPED DATA (1)
  analysis=""; low file=-1; high file=-1
!---------------------------------------------------------------------
!THE FOLLOWING DECLARATIONS DEAL WITH PD HANDLING.
  routinespec  new members(string (31) pdfile, integer  members,
         stringarrayname  in file name, integerarrayname  member flags,
          integername  flags)
  string (11) array  pdfiles(1:10)
  integerarray  pdfileflags(1:10)
!----------------------------------------------------------------------------
!THE FOLLOWING DECLARATIONS DESCRIBE THE ARRAYS ETC., USED IN THE PATTERN
!MATCHING SECTION OF ANALYSIS.
  owninteger  print = 0;  !CONTROLS THE PRINT OF LINES OF FILES.
  owninteger  record count;  !HOW MANY COMPARISONS HAVE TO BE MADE.
  owninteger  retrieve = 0;  !SET TO 1 IF THE FILE IS TO BE RETRIEVED WHOLE.
  integer  fptr0, fptr1, oldfptr1, sptr0
  sptr0 = x'58000000'
  ownbyteintegerarray  alph(0:127) = 0(128) ; ! alph used in routine search.
  switch  analsw(1:4)
  integer  absent, resolved, found
  recordformat  fkeys(integer  position, string (20) word)
  recordformat  f pattern(integer  atoms, any atom, print, keywords,
          analysis no, link, next addr, long key, record (f keys)array  keys(1:10))
  record (f pattern)array  pattern(1:50)
  record (f pattern)name  match, prc
  string (32) sok delivery; sok delivery=own dlv
  string (6) sok offer to
  owninteger  sok file action

!-----------------------------------------------------------------------------
! THE FOLLOWING DECLARATIONS ARE FOR THE AUTOMATIC MAINLOG ANAYSIS.
!  %recordformat f elb head(%integer unpo, %byteinteger rtyp, ttyp,
          seqn1, seqn2, integer  time1, time2, route, dnem, valm)
!  %record(f elb head)%name elb head
!  %recordformat f elbt smac(%integer sep, fdp, fa, est, sta, con,
          fbf, integerarray  spare(1:18))
!  %record(f elbt smac)%name elbt smac
!  %integer elb addr, elb ercount, elb base
  !IE THE ADDRESS FOR THE NEXT ICL COMPATABLE ERROR ENTRY IN THE FILE.

  recordformat  f device totals(string (6) device, integer  fails)
  record (f device totals)array  disc, smac, drum(1:20)

  owninteger  smac stream;  !THE OUTPUT STREAM FOR SMAC ERRORS.
  owninteger  smac lines=50
  owninteger  smac page=1

  constinteger  P series=0, S series = 1
  owninteger  ocptype = -1;  !The ocp type for this System.
  owninteger  systype=-1; ! 0 for P series, =1 for S series.
  ! ocptype and systype are set in INITIALISE ANALYSIS, after label code(12).
  ! The comms record (see below) is only used for this if ocp type and sys type
  ! have not been set up in the header of file JENGPD_JENGHD.  They may later
  ! be got from a mainlog (see label link2(8,9) in MAINLOG ANALYSIS).
  conststring  (4) array  ocp desc(0:15,0:1) =         c 
"29??"(2),"2960","2970","2980","2972","2976","29??"(9),
"29??","2950","2956","2966","2988","29??"(*)

!* Communications record format - extant from CHOPSUPE 22A onwards *

recordformat  comf(integer  ocptype,slipl,sblks,sepgs,ndiscs,dlvnaddr, c 
         (integer  gpctabsize,gpca or  integer  dcutabsize,dcua), c 
         integer  sfctabsize,sfca,sfck,dirsite,  c 
         dcodeda,suplvn,tojday,date0,date1,date2,  c 
         time0,time1,time2,epagesize,users,cattad,servaad,  c 
         byteinteger  nsacs,resv1,sacport1,sacport0, c 
         nocps,systype,ocpport1,ocpport0,integer  itint,contypea, c 
         (integer  gpcconfa or  integer  dcuconfa), c 
         integer  fpcconfa,sfcconfa,blkaddr,ration, c 
         (integer  smacs or  integer  scus), c 
         integer  trans,longinteger  kmon,  c 
         integer  ditaddr,smacpos,supvsn,pstva,secsfrmn,secstocd, c 
         sync1dest,sync2dest,asyncdest,maxprocs,inspersec,elaphead, c 
         commsreca,storeaad,procaad,sfcctad,drumtad,tslice,feps,  c 
         maxcbt,performad,byteinteger  dapno,dapblks,dapuser,dapstate, c 
         integer  dap1,sp1,sp2,sp3,sp4, c 
         lstl,lstb,pstl,pstb,hkeys,hoot,sim,clkx,clky,clkz,  c 
         hbit,slaveoff,inhssr,sdr1,sdr2,sdr3,  c 
         sdr4,sesr,hoffbit,blockzbit,blkshift,blksize,end)
! This format describes "The Communication Record" which is kept
! locked in store at Public address X'80C00000'. It is readable at
! all ACR levels but writeable at ACR 1 only. Its purpose is to describe
! the hardware on which the EMAS System is running.

  constrecord (comf)name  com = X'80C00000'
  owninteger  controller stream
  owninteger  controller lines
  owninteger  disc dump stream
  owninteger  disc stream
  owninteger  disc page=1
  owninteger  disc lines=50
  owninteger  drum stream
  owninteger  drum page=1
  owninteger  drum lines=56
  string (32) array  drum st(0:4)

!DISC ERROR DECLARATIONS.
  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 (f disc error)name  de
  string (10) seek, dec date, dec time; dec date=""; dec time=""
  integer  dec, epage; dec=0

!TAPE ERROR  DECLARATIONS.
    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) {126 bytes}
  record (f tape error)arrayformat  af tape error(-19:maxuniterrors)
  record (f tape error)arrayname  tape error
  record (f tape error)name  tape record a, tape record b
  owninteger  tape stream
  owninteger  tape page=1
  owninteger  tape lines=50
  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  deck record
  !THIS ARRAYS 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.
  integer  tec; tec=0
  integer  single trk hr errors, new ste f
  string (8) tec date, tec time;tec date="";tec time=""
  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) name  stei, stej, mtej
  record (f track error)arrayname  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 SIMILAR STRUCTURE FOR MULTI 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.)

!TAPE LIBRARY DECLARATIONS.
  externalroutinespec  tape library(string (255) s)
  recordformat  f deck(integer  read rcvrd, read unrcvrd, rrtot,
          write rcvrd, write unrcvrd, wrtot, mounts)
  recordformat  f tape lib(string (6) tsn, byteinteger  last used,
          integer  date, record (f deck)array  deck(1:20))
  record (f tape lib)arrayformat  af tape lib(1:10000)
  record (f tape lib)arrayname  tape lib
  record (f deck)name  tle
  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
  integername  tl fn date
  integername  tlmax
  byteintegername  tl current run
  integer  tape library addr
  integer  tl max flag
  tl max flag = 0; ! 'file full' message flag.

!SMAC ERROR DECLARATIONS.
  string (8) sec date, sec time;sec date="";sec time=""
  constintegerarray  smac fail mask(0:16)= c 
        0, 0, x'000EE3BC', x'000EE3BC', x'0000FFFA', 0, x'000EE3BC',
        0, 0, 0, 0, 0, 0, 0, 0, 0, x'000FFFFF'
  integer  sec; sec=0
  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
  record (f smac error)name  smac record

!DRUM ERROR DECS.
  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
  record (f drum error)name  drum record
  string (8) drec date, drec time;drec date="";drec time=""
  integer  drec; drec=0

  owninteger  dfc dumps, sfc dumps, gpc dumps
  !THIS ACCUMULATES THE CONTROLLER DUMPS IN THE AUTOMATIC MAINLOG ANALYSIS.

  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
  !THESE FORMATS DEFINE THE HEADER FILE FOR THE PARTITION JENGPD
  !WHICH IS THE BASIS OF THE ENGINEERS INTERACTIVE DIAGNOSTIC PACKAGE(PACKAGE C)

!--------------------------------------------------------------------
!THE FOLLOWING DECLARATIONS ARE FOR THE AUTO SPOOLR ANALYSES
  externalroutinespec  session monitor(string (255) s)
  externalroutinespec  output and background analyses(string (255) s)
  recordformat  f job entry(string (6) user, string (16) device,
          integer  size, mins qd, mins ex, byteinteger  fsys)
  record (f job entry)arrayformat  af job entry(1:100000)
  record (f job entry)arrayname  job entry
  record (f job entry)name  je
  recordformat  ijob head f( c 
     integer  end, start, size, filetype,
     checksum, date time, format, sp0,
     maxcells, freep, freen, sp1,
     halfintegerarray  list head(0:127))
  record (ijob head f)name  ijob head
  recordformat  cjob head f(integer  end, start, size, filetype, checksum,
     datetime, format, sp0, next job slot, max job slots, start date, end date)
  record (cjob head f)name  cjob head
  halfintegerarrayname  list head
  recordformat  cell f(string (6) user, string (16) device, integer  size,
    halfinteger  last, next, integer  time q, time unq, string (6) jname)
  ! This requires 48 bytes.
  record (cell f)arrayname  cell
  record (cell f)arrayformat  caf(1:100000)
  record (cell f)name  jws
  integer  start date, end date, next job slot
  integername  freen, freep, maxcells, max job slots
  if  journalsite = kent then  start 
     recordformat  f ucons entry(string (6) user,integer  pages,cards,c 
               ppfeet,gpfeet,spare5)
     record (f ucons entry)arrayformat  af ucons entry(1:4096)
     record (f ucons entry)arrayname  ucr
     record (f ucons entry)name  uce
  finish 
  if  journalsite = kent then  start 
     integer  cons file addr,cstart date,cend date
  finish 
!
!                                                         NETLOG
  owninteger  netlog stream;                            ! NETLOG
!                                                         NETLOG
!
  owninteger  batch report stream=-1
  owninteger  batch report lines =60
  string (6) array  batch user(1:20)
  string (6) last batch user
  integer  batch ucount

!-------------------------------------------------------------------------
!DECLARATIONS FOR VOLUMS ANALYSES FOLLOW.
!DECLARATIONS FOR THE AUTOMATIC VOLUMS ANALYSES.
  recordformat  f restore wk entry(integer  epages, dt req, dt arch,
          dt tape loaded, string (18) identity, string (6) tsn) {44 bytes}
  record (f restore wk entry)arrayformat  af restore wk entry(1:2000)
  record (f restore wk entry)arrayname  restore wk entry
  record (f restore wk entry)name  rwke
  recordformat  f restore table(string (6) tsn, user, byteinteger  fsys,
    integer  epages, mins rest wait, mins load wait, mins age) {32 bytes}
  record (f restore table)arrayformat  af restore table(1:60000)
  record (f restore table)arrayname  restore table
  record (f restore table)name  rte
  recordformat  f restore head(integer  end, start, size, filetype, checksum,
   datetime, format, sp0, restore entries, restore start date,
   restore end date, max entries)
  record (f restore head)name  restore head
  integer  restore entries, restore start date, restore end date
  integername  restore wk max
  string (32) identity
  string (7) loaded tape

!---------------------------------------------------------------------
!DECLARATIONS FOR DIRECT LOG ANALYSES FOLLOW.
!FIRST SET REFER TO AUTO DIRECT LOG ANALYSIS
  recordformat  f sessions list(integer  end, pageturns, cpu, elapse,
          procs, byteinteger  type, string (6) user)
  constinteger  max monthly sessions = 62000
  record (f sessions list)arrayformat  af sessions list(1:max monthly sessions)
  record (f sessions list)arrayname  sessions list
  record (f sessions list)name  sl
  integername  session total, session list start, session list end
  integer  session file connect
  constinteger  max proc slots = 256
  !NOTE: THIS MAY NOT BE ALTERED UNLESS 'T#DIRSESS' IS DESTROYED.
  recordformat  f proc slot(integer  start,
          byteinteger  type, string (6) user)
  record (f proc slot)arrayformat  af proc slot(4:max proc slots)
  record (f proc slot)arrayname  proc primary, proc secondary
  constinteger  foreground = 1
  constinteger  background=2

!----------------------------------------------------------------------------
!ROUTINES COMMON TO THE ANALYSIS SECTION NOW FOLLOW
  routine  hex to bin(string (10) s, integername  z)
  integer  l, ch, bb
  z=0
  l=length(s)
  unless  0<l<10 start 
    printstring(jtxt."Bad hex string(".S."), ignored!!")
    newline
    return 
  finish 
  for  bb=1, 1, l cycle 
    ch=byteinteger(addr(s)+bb)-'0'
    if  ch>x'10' then  ch=(ch&x'0F')+x'09'
    z = z<<4!ch
  repeat 
  end ;  !OF HEX TO I


  routine  check date and time(stringname  ddate, dtime,
          integername  flag)
    string (8) dt
    flag = 1
    return  if  4#length(ddate)#6 or  4#length(dtime)#6
    dt=date
    if  length(ddate)=4 start 
      length(ddate)=6
      charno(ddate,5) = charno(dt,7)
      charno(ddate,6) = charno(dt,8)
    finish 
    return  unless  "01"<=substring(ddate,1,2)<="31" c 
      and  "01"<=substring(ddate,3,4)<="12" and  c 
      "00"<=substring(ddate,5,6)<="99"
    ddate = substring(ddate,1,2)."/".substring(ddate,3,4)."/".substring(ddate,5,6)
    if  length(dtime)=4 start 
      length(dtime)=6
      charno(dtime,5) = '0'
      charno(dtime,6) = '0'
    finish 
    return  unless  "00"<=substring(dtime,1,2)<="23" and  c 
      "00"<=substring(dtime,3,4)<="59" and  "00"<=substring(dtime,5,6)<="59"
    dtime = substring(dtime,1,2).".".substring(dtime,3,4).".".substring(dtime,5,6)
    flag=0
    return 
  end ;  !OF CHECK DATE AND TIME.

  externalintegerfnspec  minutes between(integer  from, to)

  !THE CONSTRUCTION OF THIS MODULE IS AS FOLLOWS
  !  1)  A SECTION WHERE ALL PARAMETERS NOT CONTAINED WITHIN THE CALL
  !      ARE GOT THROUGH PROMPTS , HENCE THE ANALYSES ARE  DEFINED.
  !  2)  A SECTION THAT THEN INITIALISES ALL THE DEFINED ANALYSES,
  !      CREATING ALL THE WORK FILES REQUIRED ETC.
  !  3)  A SECTION THAT PERFORMS A ONE PASS SCAN OF THE DEFINED LOGS
  !      AND, ON KEY MATCH, PERFORMS THE REQUIRED ANALYSES.
  !  4) A SECTION THAT CLOSES THE ANALYSES AND PRODUCES ANY REPORTS.




  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !THE PARAMETER(S) CATCHING SECTION OF JOURNAL ANALYSIS FOLLOWS.


  !Because this section may be called more than once in a run (ie during
  !auto analysis for Mainlogs, then for Spoolr logs) we must reinitialise
  !the variables here.
!M*  PRINTSTRING("Entry to Journal analysis:")
!M*    METER(S)
  retrieve = 0; record count = 0; print = 0; next stream = 11
  general stream = 0; current chapter = -1; tape unit = 1
  dt from = pack date and time("01/01/70","00.00.00")
  dt to = pack date and time("31/12/99","23.59.59")
  anal no = -1; link = 0
  if  s="ENGCALL" then  engineer interaction=on and  s=""
  if  length(s)>8 and  substring(s, 1, 8)="MANFACL:" start 
    s -> ("MANFACL:").s
    !ie a call from the management package (D) for access to
    !THE MANAGEMENT ANALYSES , THE FIRST ANALYSIS ON THE KEYWORD BEING
    !CONTAINED IN THE CALL.
    !(I.E. MANFACL:SPOOLR, BACKGROUND SUMMARY)
    man facility=on
    man facility call=s
    s=""
  finish 
  if  length(s)#0 start 
    !The parameters have been passed by the routine call (by Journal).
    if  s="ENGSPECIAL" start 
      !The call is from ENGINEER SUMMARY and has provided the most up
      !to date main log (in JENGSP) for a complete analysis excluding
      !certain sections of the accumulation since this file will be
      !reanalysed automatically at the next full run of Journal. the
      !line printer reports are not produced and the device summaries
      !are left in the files JSUM, JTAPE, .. etc for the calling
      !program.
      engineer special=on
      keyword="MAINLOG"
    finish  else  start ; ! s is assumed to be of form llllhhhh.
      parameters==record(addr(s)+1)
      low file = s to i(parameters_lower file)
      high file = s to i(parameters_upper file)
      analysis=parameters_analysis
      keyword=parameters_keyword
    finish 
    identify index(keyword, id char, data type, entry)
    !CHECK THE VALIDITY OF THE KEYWORD.
    if  id char=100 start 
      printstring(jtxt."Invalid keyword: ".keyword)
      newlines(2)
      return 
    finish 
    index="JJ#".intostr(id char)."DEX"
    connect(index, 0, 0, 0, r, flag)
    if  flag#0 then  master file failure(index, flag)
    index entry==array(r_conad+x'40', af index entry)
  finish  else  start 
    !We must get the parameters from prompting.
    printstring(jtxt."Note that an asterisk before a prompt indicates
          that replying HELP gives help information.")
    newline
    cycle 
      if  man facility=on start 
        !THE CALL INCLUDES THE KEYWORD SO NO NEED TO PROMPT(FROM MANAGEMENT
        !PACKAGE(D).
        man facility call->reply.(",").man facility call
      finish  else  start 
        if  engineer interaction=on then  reply="MAINLOG" else  start 
          prompt("*Keyword:")
          read prompt reply(reply)
        finish 
      finish 
      if  0<length(reply)<=12 and  reply#"HELP" start 
        identify index(reply, id char, data type, entry)
        if  id char=100 then  c 
        printstring(jtxt."Invalid keyword: ".reply) and  c 
        newline else  keyword=reply and exit 
      finish 
      if  reply="HELP" then  print help(1)
    repeat 
    !WE NOW HAVE ESTABLISHED THE FILE TYPE.
    index="JJ#".intostr(id char)."DEX"
    connect(index, 0, 0, 0, r, flag)
    if  flag#0 then  master file failure(index, flag)
    bottom file=integer(r_conad+x'2C')
    top file=integer(r_conad+x'20'); ! This is the first free slot.
    index entry==array(r_conad+x'40', af index entry)

    if  engineer interaction=on or  man facility = on then  reply="DATES" else  start 
      !If engineer analysis or management analysis chose files by dates only.
      cycle 
        prompt("*Dates/Files:")
        read prompt reply(reply)
        if  reply="DATES" or  reply="FILES" then  exit 
        if  reply="HELP" then  print help(2)
      repeat 
    finish 
    if  reply="FILES" start 
      prompt("Lower file:")
      read prompt reply(reply)
      low file = s to i(reply)
      prompt("Upper file:")
      read prompt reply(reply)
      high file = s to i(reply)
      if  0<=low file<=9999 and  0<=high file<=9999 start 
        !CONVERT THE FILE RANGE TO AN INDEX ENTRY SEQUENCE.
        i=bottom file
        cycle 
          if  index entry(i)_file id=low file start 
            low file=i
            exit 
          finish 
          i=cyclic(i, 1)
          exit  if  i=bottom file or  index entry(i)_status=8
        repeat 
        if  lowfile#i start 
          printstring(jtxt."Lower file does not exist as specified!")
          newlines(2)
          return 
        finish 
        cycle 
          if  index entry(i)_file id=high file start 
            high file=i
            exit 
          finish 
          i=cyclic(i, 1)
          exit  if  i=bottom file or  index entry(i)_status=8
        repeat 
        if  high file#i start 
          i=cyclic(i, -1)
          printstring(jtxt."Top file is no: ")
          printstring(intostr(index entry(i)_file id))
          printstring(", using this as upper bound.")
          newline
          high file=i
        finish 
      finishelsestart 
        printstring(jtxt."Invalid file range!")
        newline
        return 
      finish 
    finish  else  start ; ! Dates
      cycle 
        prompt("*Low date,time:")
        cycle 
          read prompt reply(reply)
          print help(3) and  continue  if  reply="HELP"
          if  reply->ddate.(",").dtime start 
            check date and time(ddate, dtime, flag)
            exit  if  flag=0
          finish 
          printstring(jtxt."Check your reply!")
          newline
        repeat 
        dtfrom=pack date and time(ddate, dtime)
        prompt("*Hi date,time:")
        cycle 
          read prompt reply(reply)
          print help(3) and  continue  if  reply="HELP"
          if  reply->ddate.(",").dtime start 
            check date and time(ddate, dtime, flag)
            exit  if  flag=0
          finish 
          printstring(jtxt."Check your reply!")
          newline
        repeat 
        dtto=pack date and time(ddate, dtime)
        exit  unless  dtto<dtfrom
        newline
        printstring(jtxt."Unordered time sequence?")
        newline
      repeat 
    finish 
  finish 

  if  lowfile=-1  and  engineer special=off start 
    !IE WE DO NOT KNOW THE FILE SEQUENCE AND IT IS NOT A CALL
    !FROM ENGINEER SUMMARY WHICH GIVES THE SINGLE FILE(JJ#TEMP) REQUIRED.
    !THE FILE RANGE MUST BE DETERMINED FROM THE DATE PERIOD.
    if  dtfrom<index entry(bottom  file)_starting start 
      if  dtto<index entry(bottom file)_starting start 
        printstring(jtxt."Files do not go back that far!")
        newline
        return 
      finish 
      dtfrom=index entry(bottom file)_starting
      printstring(jtxt."Oldest file dated: ")
      printstring(unpackdate(dtfrom))
      printstring(" ".unpacktime(dtfrom))
      newline; printstring("          Using this as lower bound.")
      newlines(2)
    finish 
    if  dtfrom>index entry(cyclic(top file,-1))_finishing start 
      printstring(jtxt."No files for this range (yet!).")
      newline
      return 
    finish 

    posn=bottom file
    cycle 
      exit  if  dtfrom<=index entry(posn)_finishing
      posn = cyclic(posn, 1)
      if  posn=bottom file or  index entry(posn)_status=8 start 
        printstring(jtxt."Search for earliest file fails.")
        newline
        return 
      finish 
    repeat 
    lowfile = posn

    posn = cyclic(topfile,-1)
    cycle 
      exit  if  dtto>=index entry(posn)_starting
      posn = cyclic(posn,-1)
      if  posn=topfile or  index entry(posn)_status=8 start 
        printstring(jtxt."Search for latest file fails.")
        newline
        return 
      finish 
    repeat 
    high file = posn
    if  low file=cyclic(high file, 1) start 
      printstring(jtxt."No files for this period!")
      newlines(2)
      return 
    finish 
    printstring(jtxt."The file range is ")
    printstring(intostr(index entry(low file)_file id))
    printstring(" : ".intostr(index entry(high file)_file id))
    newline
  finish 
  if  (analysis="AUTOMATIC" or  engineer special=on) c 
  and  entry<=system indices start 
    !WE LUMP TOGETHER AND DO ALL THE ANALYSES FOR THIS INDEX TYPE
    !THAT ARE RELEVANT TO THE DAILY AUTO ANALYSIS OF THE FILES
    !OR RELEVANT TO THE REQUESTED ANALYSIS OF THE CURRENT MAINLOG.
    if  keyword="MAINLOG" start 
      !DO THE AUTO ANALYSES OF THE MAIN LOGS.
      base=10*(entry+1)
      !THIS GIVES US A LINK TO THE INITIALISATION CODE.

      initialise analysis(base+1) if  engineer special=off
      !THE MAIN LOG ACCUMULATION ANALYSES THAT CAN ONLY BE RUN FROM
      !THE AUTOMATIC CALL AND NOT BY A CALL ON JOURNAL ANALYSIS BY
      !A 'USER' SINCE THIS WOULD CORRUPT THE ACCUMULATED DATA BY
      !DUPLICATION SAY.

      initialise analysis(base+2)
      !THE REMAINING ANALYSES THAT COULD BE RUN  AT ANY TIME UNLIKE THE
      !ABOVE.
      !NOW INITIALISE THE MANAGEMENT REPORTING SECTIONS OF THE
      !AUTOMATIC MAINLOG ANALYSIS.
      !INITIALISE ANALYSIS(BASE+5)
    finish  else  if  keyword="SPOOLR" start 
      !SET UP AND EXECUTE THE AUTO ANALYSES OF THE SPOOLR LOGS.
      base=10*(entry+1)
      !LINK TO THE SPOOLR INITIALISATION CODE.
      initialise analysis(base+1)
    finish  else  if  keyword="DIRECT" start 
      !SET UP AND EXECUTE THE AUTO ANALYSES OF THE DIRECT LOGS.
      base=10*(entry+1)
      !LINK TO THE SPOOLR INITIALISATION CODE.
      initialise analysis(base+1)
    finish  else  if  keyword="VOLUMS" start 
      !SET UP AND EXECUTE THE AUTO ANALYSES OF THE VOLUMS LOGS.
      base=10*(entry+1)
      !LINK TO THE SPOOLR INITIALISATION CODE.
      initialise analysis(base+1)
    finish 
  finish  else  start 
    !GET THE REQUIRED ANALYSES BY PROMPTS.
    cycle 
      flag=0
      newline
      if  man facility = on start 
        !THE CALL IS FROM THE MANAGEMENT PACKAGE(D)
        !WITH THE FIRST ANALYSIS DEFINITION IN THE CALL PARAMS.
        reply=man facility call
        man facility call=""
        if  reply="" start 
          !IT IS NOT THE FIRST ANALYSIS REQUEST OF THE SYSTEM SO ASK.
          prompt("Other summary:")
          read prompt reply(reply)
        finish 
      finish  else  start 
        !IT IS A NORMAL CALL OF JOURNAL ANALYSIS
        prompt("*Option:")
        read prompt reply(reply)
      finish 
      if  0<length(reply)<33 start 
        exit  if  reply="END"
        stop  if  reply="STOP"
        if  entry<=system indices start 
          !WE ARE DEALING WITH A 'SYSTEM' FILE TYPE.
          base=10*(entry+1)
          for  i=1, 1, 10 cycle 
            !There can be up to ten separate analyses for each type.
            if  system analyses(i, entry)=reply start 
              initialise analysis(base+i)
              !INITIALISE THE REQUIRED ANALYSIS.
              flag=1
              exit 
            finish 
          repeat 
        finish 
        if  flag = 0 start 
          for  i=1, 1, 10 cycle 
            !CHECK THE COMMON ANALYSES.
            if  common analyses(i)=reply start 
              initialise analysis(i)
              flag=1
              exit 
            finish 
          repeat 
        finish 
        if  flag=0 start 
          if  reply = "HELP" start 
            if  engineer interaction = on then  print help(7) c 
             else  print help(4)
          finish  else  start 
            printstring(jtxt.reply." not valid analysis!")
            newline
          finish 
        finish 
      finish  else  start 
        printstring(jtxt."Reply incorrect length (max: 32 chars)")
        newline
      finish 
      if  engineer interaction=on and  flag=1 then  exit 
      !ALLOW ENGINEERS ONE ANALYSIS ONLY.
      if  flag=1 and  data type=1 then  exit 
      !ONLY ONE ANALYSIS TYPE ALLOWED AT A TIME FOR MAPPED DATA FILES.
    repeat 
    !NOW ALL THE ANALYSES HAVE BEEN INITIALISED.
  finish 
  !GO ON AND RUN THROUGH THE ANALYSES.
  if  retrieve = off and  record count=0 and  anal no=-1 start 
    !ANAL NO WILL ONLY BE SET AT THIS STAGE IF A SINGLE ANALYSIS
    !IS TO BE PERFORMED ON A MAPPED DATA FILE. OTHERWISE LOOK TO SEE
    !IF A FILE RETRIEVAL OR MULTIPLE ANALYSIS OF A TEXT FILE IS REQUIRED.
    printstring(jtxt."No analyses requested!")
    newline
    return 
  finish 

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !THE MAIN ANALYSIS LOOP FOLLOWS.

  !Find the largest key in each set (used later when scanning for suitable
  !file lines to examine in more detail.)
  for  ii=1,1,record count cycle 
     match == pattern(ii)
     match_long key <- 1
     l = length(match_keys(1)_word)
     for  j = 2,1,match_keywords cycle 
        if  l<length(match_keys(j)_word) start 
           match_longkey <- j
           l = length(match_keys(j)_word)
        finish 
     repeat 
     ! Now match_longkey points to the longest key in set ii.
  repeat 

  !NOW START THE MAIN LOOP PROPER.
  section=0
  if  keyword="MAINLOG" then  section=1
  if  keyword="VOLUMS" then  section=2
  if  keyword="SPOOLR" then  section=3
  if  keyword="DIRECT" then  section=4
  i=low file;  !IS A POINTER TO THE INDEX ENTRY OF THE EARLIEST FILE TO BE ANALYSED.
  cycle 
    retrieve file(i, dtfrom, dtto, flag)
    if  flag=0 start 
      !THE FILE HAS BEEN RETRIEVED SUCCESSFULLY.
      if  engineer special=off start 
        log start = index entry(i)_starting
        log finish = index entry(i)_finishing
      finish 
      if  retrieve=on start 
        !THE FILE IS REQUIRED IN FULL
        filename="J".intostr(id char)."I" c 
          .intostr(index entry(i)_file id)
        copy(tempfile.",".filename)
        printstring(jtxt."File covers period: ")
        printstring(unpackdate(log start)." ")
        printstring(unpacktime(log start)." ")
        printstring(" to ".unpackdate(log finish))
        printstring(" ".unpacktime(log finish))
        newline
        deliver(delivery)
        if  file action=1 then  send(filename.",.".print device)
        if  file action=2 then  list(filename.",.".print device)
        if  2<=file action<=3 and  offerto#"JOURNL" start 
          offer(filename, offerto, flag)
          if  flag#0 start 
            printstring(jtxt."Failed to offer!")
            newline
          finish 
        finish 
        deliver(own dlv)
      finish 
      if  record count>0 start 
        connect(tempfile, 0, 0, 0, r, flag)
        if  flag#0 start 
          printstring(jtxt."Fail to connect tempfile, flag: ")
          write(flag, 3); newlines(2)
          return 
        finish 
        endflag=0
        fptr0=x'58000000'!(integer(r_conad)-integer(r_conad+4))
        fptr1=r_conad+integer(r_conad+4)
        print = 0
        absent = 0
        for  j = 1,1,record count cycle 
           match == pattern(j)
           match_nextaddr <- search(match_keys(match_long key)_word)
           ! This returns the address of the next occurrence of the parameter,
           ! or 0.  Search range: fptr1+1 to end-of-file.
           absent = absent+1 if  match_nextaddr=0
        repeat 
        ! Above cycle sets up addresses to speed up keyword matching.
        ! absent gives the number of key sets which do not occur at all in
        ! (the rest of) the file.

        cycle 
          exit  if  absent=record count and  print=0; ! Nothing left to be found.
          get next line
          exit  if  endflag=1
          for  line=1, 1, record count cycle 
            match==pattern(line)
            continue  unless  oldfptr1<match_nextaddr<fptr1
            ! Longest keyword (at least) appears in line.
            match_nextaddr <- search(match_keys(match_longkey)_word)
            ! Sets _nextaddr to next possible match.
            absent = absent+1 if  match_nextaddr=0
            resolve line if  resolved=no
            ! "resolved" set by "get next line" and by "resolve line".
            continue  if  word count<match_atoms; ! Line too small.
            if  match_any atom=1 start 
              !THIS MEANS A SEARCH ON ALL ATOMS FOR A RECOGNISED SET
              !OF KEYS.
              words=match_keys(1)_position
              !THIS GIVES A COUNT OF THE CONSECUTIVE KEYWORDS.
              for  j=1, 1, word count cycle 
                exit  if  words>word count-j+1; ! NOT ENOUGH WORDS LEFT FOR KEY.
                !LOOK AT EACH WORD IN THE INPUT LINE.
                if  compare st(j, match_keys(1)_word)=matched start 
                  !WE HAVE A MATCH ON THE FIRST WORD.
                  flag=1
                  for  k=2, 1, words cycle 
                    !NOW LOOK AT THE REMAINING WORDS (IF ANY).
                    if  compare st(j+k-1, match_keys(k)_word)=matched c 
                       then  flag=k else  exit 
                  repeat 
                  if  flag=words start 
                    !WE HAVE A COMPLETE MATCH
                    print=match_print
                    !SET LINES TO PRINT AFTER THIS MATCH.
                    exit 
                  finish 
                finish 
              repeat 
            finish  else  start 
              flag=0
              for  j=1, 1, match_keywords cycle 
                !CYCLE THROUGH EACH OF THE DEFINED KEYWORDS IN THE LINE
                if  comparest(match_keys(j)_position,
                 match_keys(j)_word)=unmatched then  flag=1 and  exit 
                !IE A MISMATCH OF THE KEYWORD.
              repeat 
              if  flag=0 start 
                !A COMPLETE MATCH HAS BEEN FOUND.
                if  match_analysis no<0 then  c 
                  common analysis(-match_analysis no, match_link) and  continue 
                ->analsw(section)
                analsw(1):
                    mainlog analysis(match_analysis no, match_link); continue 
                analsw(2):
                    volums analysis(match_analysis no, match_link); continue 
                analsw(3):
                    spoolr analysis(match_analysis no, match_link); continue 
                analsw(4):
                    direct analysis(match_analysis no, match_link); continue 
              finish 
            finish 
          repeat 
          if  print>0 start 
            !There are lines to be printed.
            select output(general stream)
            print log line
            selectoutput(0)
            print=print-1
            !IE ONE LESS LINE TO BE PRINTED
          finish 
        repeat 
      finish  else  start 
        if  data type=1 and  retrieve=0 start 
          !ANALYSIS OF MAPPED DATA FILE.
          if  keyword="ACCOUNTS" then  accounts analysis(anal no, link)
        finish 
      finish 
    finish 
    exit  if  i=high file or  i=-1
    !I=-1 ONLY WHEN THE ENGINEER SPECIAL ANALYSIS OF THE CURRENT
    !MAINLOG HAS BEEN RUN.
    i=cyclic(i, 1)
  repeat 
!M*  PRINTSTRING("End of main loop/start of close section:")
!M*    METER(S)
  close analyses if  close list(0)>0;  !IF THERE ARE ANY REQUIRING SPECIAL ATTENTION.
  printstring(jtxt."Analyses completed.")
  newlines(2)
!M*  PRINTSTRING("End of analysis call:")
!M*    METER(S)
  destroy("JJ#TEMP", flag)
  if  tape up#"" then  unload mag(tape unit)
  !IE RELEASE THE TAPE AT END OF ANALYSIS.
  return 

  !*************************************
  !  R O U T I N E S 
  !*************************************


  !******************************************
  routine  initialise analysis(integer  link)
!M*      PRINTSTRING("Start of initialisation and key sort:")
!M*    METER(S)
    !THIS ROUTINE WILL USE THE VALUE OF 'LINK' TO JUMP TO
    !THE CODE TO INITIALISE THE REQUIRED ANALYSIS.
    integer  i, j, k, conad, flag
    string (32) type
    switch  code(1:60)

    routine  matchword(integer  table entry, number, position,
          string (20) word)
      !THIS ROUTINE MAKES AN ENTRY IN THE SEARCH TABLE FOR A KEYWORD.
      pattern(table entry)_keys(number)_position<-position
      pattern(table entry)_keys(number)_word<-word
    end ;  !OF ROUTINE MATCHWORD.


    routine  report header(integer  stream, string (4) devtype)
      !THE ROUTINE IS USED BY MAINLOG ANALYSIS TO PRINT A REPORT HEADER.
      integer  i
      return  if  engineer special=on
      !DO NOT GIVE A HEADER FOR CURRENT MAINLOG RUN.
      select output(stream)
      newlines(10)
      printstring("EMAS ".ocp desc(ocptype, systype)." Journal report")
      spaces(10); printstring(devtype." error report        ")
      printstring("Printed at ".time." on ".date)
      newline
      printsymbol('=') for  i=1, 1, 110
      newlines(3)
      printstring("This report covers the period:  ")
      printstring(unpacktime(index entry(low file)_starting)." on ")
      printstring(unpackdate(index entry(lowfile)_starting)." to ")
      printstring(unpacktime(index entry(high file)_finishing)." on ")
      printstring(unpackdate(index entry(high file)_finishing))
    end ;  !OF ROUTINE REPORT HEADER.

    if  length(s)#0 then  type="AUTOMATIC" else  type=reply
    ->code(link)

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !  THE COMMON ANALYSIS
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    code(1):
    !THIS IS THE COMMON ANALYSIS USED TO PRINT(RETRIEVE) THE WHOLE
    !SPECIFIED FILES.
    retrieve=on
    cycle 
      prompt("*Output option:")
      read prompt reply(reply)
      file action = 1 if  reply="SEND"
      file action = 2 if  reply="LIST+OFFER"
      file action = 3 if  reply="OFFER"
      exit  if  file action#0
      if  reply="HELP" then  print help(6)
    repeat 
    if  file action<3 start 
      cycle 
        prompt("Deliver to:")
        read prompt reply(reply)
        exit  if  length(reply)<33
      repeat 
      delivery=reply
      if  print device = "" start 
        cycle 
         prompt("*Which printer:")
          read prompt reply(reply)
          if  reply="HELP" then  print help(8)
          if  reply # "HELP" then  print device = reply and  exit 
        repeat 
      finish 
    finish 
    if  2<=file action<=3 start 
      cycle 
        prompt("Offer to:")
        read prompt reply(reply)
        exit  if  length(reply)=6
      repeat 
      offerto=reply
    finish 
    printstring(jtxt."'".type."' analysis initialised.")
    newline
    return 

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    code(2):
    !THIS IS THE COMMON ANALYSIS USED TO SEARCH AND PRINT FILE
    !EXTRACTS BASED ON THE RECOGNITION OF A USER DEFINED KEY.
    if  data type=1 start 
      printstring(jtxt."Analysis not permitted for mapped data")
      printstring(" files!"); newlines(2)
      return 
    finish 
    prompt("*Fixed or Free:")
    cycle 
      read prompt reply(reply)
      if  reply="HELP" then  print help(5)
      exit  if  reply="FIXED" or  reply="FREE"
    repeat 
    prc == pattern(record count+1)
    if  reply="FREE" start 

      prc_any atom<-1
      !Set the free search key.
      i = 0
      while  i<10 cycle 
         i = i+1
         prompt("Matchword ".intostr(i).":")
         read description(reply); ! Note: case sensitive.
         exit  if  reply="!END" or  reply="!end"
         if  0<length(reply)<=20 then  prc_keys(i)_word<-reply c 
           else  start 
            printstring("Search on key:  ".reply." wrong length")
            printstring(" (max 20)")
            newline
            i = i-1
          finish 
      repeat 
      if  "!end"#reply#"!END" start 
         printstring("Search on key: no more keywords allowed.")
         newlines(2)
         i = 11
      finish 
      prc_atoms=i-1
      !THE MINIMUM LINE LENGTH FOR A MATCH.
      prc_keywords = i-1
      prc_keys(1)_position=i-1
      !COUNT OF NUMBER OF KEYWORDS.
      cycle 
        prompt("Lines of print:")
        read prompt reply(reply)
        i = s to i(reply)
        if  i<=0 start 
          printstring("Search on key:  must print at least one line")
          newline
        finish  else  start 
          prc_print=i
          exit 
        finish 
      repeat 

    finish  else  start 
      j=0
      prc_any atom=0
      !IT IS THE FIXED POSITION KEY SEARCH.
      i = 0
      while  i<10 cycle 
        i = i+1
        newline
        printstring("Matchword ".intostr(i).":"); newline
        prompt("Position:")
        read prompt reply(reply)
        exit  if  reply="!END"
        k = s to i(reply)
        if  k>j then  j=k;  !THE TOP MATCHWORD.
        prompt("Matchword:")
        read description(reply); !Note: case sensitive.
        matchword(record count+1, i, k, reply)
      repeat 
      if  "!end"#reply#"!END" start 
         printstring("Search on key: no more keywords allowed.")
         newlines(2)
         i = 11
      finish 
      prc_atoms=j
      prc_keywords=i-1
      prompt("Lines of print:")
      cycle 
        read prompt reply(reply)
        i = s to i(reply)
        if  i<=0 start 
          printstring("Search on key:  must print at least one line!")
          newline
        finish  else  start 
          prc_print=i
          exit 
        finish 
      repeat 
      prc_analysis no=-2
      prc_link=0
    finish 
    record count=record count+1

    if  general stream=0 start 
      next stream=nextstream+1
      !OPEN THE GENERAL OUTPUT STREAM.
      general stream=next stream
      define("STREAM".intostr(general stream).",JJANL,1024")
      select output(general stream)
      printstring("Journal 'on key' report ".date." ".time)
      newlines(4)
      select output(0)
      prompt("*Output action:")
      cycle 
        read prompt reply(reply)
        sok file action=1 if  reply="SEND"
        sok file action=2 if  reply="LIST+OFFER"
        sok file action=3 if  reply="OFFER"
        exit  if  sok file action#0
        if  reply="HELP" then  print help(6)
      repeat 
      if  sok file action<3 start 
        prompt("Deliver to:")
        cycle 
          read prompt reply(reply)
          exit  if  length(reply)<33
        repeat 
        sok delivery=reply
        if  print device = "" start 
          prompt("*Which printer:")
          cycle 
            read prompt reply(reply)
            if  reply="HELP" then  print help(8)
            if  reply="" then  print device = "LP" and  exit 
            if  reply # "HELP" then  print device = reply and  exit 
          repeat 
        finish 
      finish 
      if  2<=sok file action<=3 start 
        prompt("Offer to:")
        cycle 
          read prompt reply(reply)
          exit  if  length(reply)=6
        repeat 
        sok offer to=reply
      finish 
    finish 
    close list(0)=close list(0)+1
    close list(close list(0))=link
    !THIS RETRIEVE MUST BE TIDIED UP AT THE END.
    printstring(jtxt."'".type."' analysis initialised.")
    newline
    return 


    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !  THE MAINLOG ANALYSIS.
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    code(11):
    !THIS IS THE MAINLOG AUTO ACCUMULATIVE ANALYSIS RESERVED TO BE
    !RUN ONLY BY CALL FROM THE COLLECTING PROGRAM (JOURNAL).
    full run=on;  !PERMITS THE TOTAL ANALYSIS INCLUDING ACCUMULATION UPDATES.
    !SUSPEND THIS SECTION UNTIL FURTHER DISCUSSION ON ICL COMPATABLE CODE.
    !NOW CREATE THE ICL COMPATABLE OUTPUT FILE AND MAKE ANALYSIS
    !(KEY) ENTRIES FOR EACH RELEVANT LINE TYPE.
    !WITH THE RELEVANT SETTING OF 'LINK' FOR ANAL NO=1(MAINLOG)
!    OUTFILE("ICLERROR", 128*4096, 0, 0, CONAD, FLAG)
!    %IF FLAG#0 %THEN %START
!      PRINTSTRING(jtxt." create 'ICL error file' fails....disaster")
!      NEWLINE; !PRINTSTRING("          fails: "); !WRITE(FLAG, 2)
!      NEWLINES(2)
!      %STOP
!    %FINISH
!    ELB BASE=CONAD
!    ELB ADDR=CONAD+X'20'
    connect(control, 0, 0, 0, r, flag)
    if  flag#0 then  master file failure(control, flag)
!    elb ercount=integer(r_conad+x'28')
    !THE CYCLIC ERROR COUNT(FOR ICL COMP ERROR LOGGING).

    !-----------------------------------------------------------------
    !INITIALISATION OF THE TAPE LIBRARY STRUCTURE, ONLY APPLICABLE
    !WHEN THE RUN IS AN AUTOMATIC ANALYSIS OF THE MAINLOGS.
    connect("JENGPD_JTAPELIB", 0, 0, 0, r, flag)
    if  flag#0 start 
      printstring(jtxt."Creating new tape library file.")
      i = 200; ! The number of slots available for tapes.
      newline
    finish  else  start 
      i = integer(r_conad+x'20'); ! Actual no. of slots in use in file.
      i = i+200; ! 200 extra slots.
    finish 
    outfile("JTAPELIB", x'100'+i*576, 0, 0, conad, flag)
    if  flag#0 start 
      printstring(jtxt."Failed to create tape library work file")
      printstring(", flag; ".intostr(flag))
      newline
      printstring("          run abandoned!!")
      newlines(2); stop 
    finish 
    ! x'20'   tl rec count (current no of tapes in file)
    ! x'24'   tl max       (maximum no of tapes which can be stored in file)
    ! x'28'   tl fn date
    ! x'30'.. deck identity (array of tape decks in file)
    ! x'100'.. tape library (array of tapes in file)

    tape lib == array(conad+x'100', af tape lib)
    deck identity == array(conad+x'30', af deck identity)
    tape library addr=conad
    tl rec count == integer(conad+x'20')
    tl max == integer(conad+x'24')
    tl fn date == integer(conad+x'28')
    tl current run ==  byteinteger(conad+x'2C')

    tl max = i
    if  tl max>200 start ; ! JENGPD_JTAPELIB exists - copy info from it.
      move(x'100'-x'20'+integer(r_conad+x'20')*576, r_conad+x'20', conad+x'20')
      tl max = i
    finish 

    ! Now check tape records and remove those not referenced in the last 256
    ! invocations of Journl.
    tl current run = (tl current run+1)&255
    i = 0
    while  i<tl rec count cycle 
      i = i+1
      while  tl current run=tape lib(i)_last used cycle 
         ! Remove this tape entry, and move the last one into its place.
         ! Also check the last one, in case it is out of date also.
         tape lib(i) = tape lib(tl rec count)
         tl rec count = tl rec count-1
         exit  if  tl rec count<i
      repeat 
    repeat 

    !Set up the pattern to catch tape mounts

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=8
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=1
    prc_link=1
    matchword(record count, 1, 4, "OPERLOG")
    matchword(record count, 2, 7, "LOADED")
    close list(0)=close list(0)+1
    close list(close list(0))=link
    !WILL NEED TO BE TIDIED UP AT END
    if  type="ENG RERUN" then  link=12 else  return 
    !This allows testing of accum section by hand.

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    code(12):
    !This is the mainlog analysis for the production of daily
    !reports from the mainlogs that can be repeated manually(usually
    !called automatically) without affecting the accumulation reports.

    connect("JENGPD_JENGHD", 0, 0, 0, r, flag)
    ! Get ocptype and systype from JENGPD_JENGHD, if set up there.  If not,
    ! get from the comms record.  (Later they may be picked up when analysing
    ! a mainlog.)
    if  flag=0 start 
      if  0<=integer(r_conad+x'100')<=15 then  ocptype=integer(r_conad+x'100')
      if  0<=integer(r_conad+x'FC') then  systype=integer(r_conad+x'FC')
    finish 
    if  ocptype = -1 then  ocptype = com_ocptype
    if  systype = -1 then  systype = com_systype
    epage=block//1024
    if  epage>8 start 
      printstring(jtxt."Disaster, >8 1k blocks/epage")
      newlines(2)
      stop 
    finish 
    !IE HOW MANY K BYTES IN AN EPAGE ON THIS SYSTEM.
    !NOW CLEAR DOWN THE DEVICE TABLES THAT PRODUCE THE ENGINEERS SUMMARY. PAGE.
    for  i=1, 1, 20 cycle 
      disc(i)=0
      drum(i)=0
      smac(i)=0
    repeat 

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=5
    prc_any atom=0
    prc_keywords=1
    prc_analysis no=2
    prc_link=8
    matchword(record count, 1, 4, "OCPTYPE")

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=6
    prc_any atom=0
    prc_keywords=1
    prc_analysis no=2
    prc_link=9
    matchword(record count, 1, 4, "OCP")

    !--------------------------------------------
    ! SMAC ERRORS.

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=12
    prc_any atom=0;  !FIXED POSITION KEYS.
    prc_keywords=2
    prc_analysis no=2
    prc_link=1
    matchword(record count, 1, 2, "STORE")
    matchword(record count, 2, 3, "ERROR")
    outfile("JSMAC", (max unit errors*91+x'40'), 0, 0, conad, flag)
    monitor  and  stop  if  flag#0
    smac error==array(conad+x'40', af smac error)
    next stream=next stream+1
    smac stream=next stream
    define("STREAM".intostr(smac stream).",JSMACERRORS,1024")
    report header(smac stream, "SMAC")

    !--------------------------------------------
    !  DISC ERRORS.

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=10
    prc_any atom=0
    prc_keywords=3
    prc_analysis no=2
    prc_link=2
    matchword(record count, 1, 2, "DISC")
    matchword(record count, 2, 3, "TRANSFER")
    matchword(record count, 3, 8, "FAILS")
    outfile("JDISC", (max unit errors*133+x'40'), 0, 0, conad, flag)
    monitor  and  stop  if  flag#0
    disc error==array(conad+x'40', af disc error)
    next stream=next stream+1
    disc stream=next stream
    define("STREAM".intostr(disc stream).",JDISCERRORS,1024")
    report header(disc stream, "DISC")

    !--------------------------------------------
    !CONTROLLER(DFC, GPC, SFC) DUMP COUNTER AND REPORT

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=4
    prc_any atom=0
    prc_keywords=3
    prc_analysis no=3
    prc_link=1
    matchword(record count, 1, 1, "&&")
    matchword(record count, 2, 2, "DUMP")
    matchword(record count, 3, 3, "OF")
    next stream=next stream+1
    controller stream=next stream
    define("STREAM".intostr(controller stream).",JCONTROLLER,1024")
    report header(controller stream, "CONTROLLER")
    !THIS REPORTS ON THE TOTAL DFC DUMPS FOR THE PERIOD CONCERNED.
    !A STATEMENT OF THE TOTAL DUMPS APPEARING AT THE HEAD OF THE DISC REPORT.
    !AND A FULL LISTING OF THE DUMPS TO LP.

    !------------------------------------------------
    !DRUM ERRORS.

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=7
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=2
    prc_link=3
    matchword(record count, 1, 1, "&&")
    matchword(record count, 2, 2, "DRUM")
    outfile("JDRUM", (max unit errors*485+x'40'), 0, 0, conad, flag)
    if  flag#0 start 
      printstring(jtxt."Cannot create drum error file!!")
      newlines(2)
      stop 
    finish 
    drum error==array(conad+x'40', af drum error)
    next stream=next stream+1
    drum stream=next stream
    define("STREAM".intostr(drum stream) .",JDRUMERRORS,1536")
    report header(drum stream, "DRUM")

    !---------------------------------------------
    !TAPE ERROR TRAPPING INITIALISATION.

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=6
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=2
    prc_link=4
    matchword(record count, 1, 5, "RETRY")
    matchword(record count, 2, 6, "OK")
    !This defines  the tape error successful retries.

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=4
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=2
    prc_link=5
    matchword(record count, 1, 2, "UNRECOVERED")
    matchword(record count, 2, 3, "ERROR")
    !This defines the unrecovered tape errors.

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=4
    prc_any atom=0
    prc_keywords=3
    prc_analysis no=2
    prc_link=6
    matchword(record count, 1, 1, "TAPE")
    matchword(record count, 2, 2, "ERROR//")
    matchword(record count, 3, 3, "ABNORMAL")
    !This defines the presence of a tape dump table.
    outfile("JTAPE", (x'cd90'+(max unit errors+20)*126), 0, 0, conad, flag)
    monitor  and  stop  if  flag#0
    tape error==array(conad+x'cd90', af tape error)
    deck errors==array(conad+x'40', af deck errors)
    tape fail levels==array(conad+x'c390', af t f l)
    !These slots are used to keep track of the current state
    !of error on each deck (up to 20 units).
    mte==array(conad+x'6300', af track error)
    !ie the deck by deck multi track error recording.
    next stream=next stream+1
    tape stream=next stream
    define("STREAM".intostr(tape stream).",JTAPEERRORS,1024")
    report header(tape stream, "TAPE")

    !----------------------------------------------------
    !SINGLE TRACK(TAPE) ERROR REPORTING.
    single trk hr errors=0

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=12
    prc_any atom=0
    prc_keywords=3
    prc_analysis no=2
    prc_link=7
    matchword(record count, 1, 3, "SINGLE")
    matchword(record count, 2, 4, "TRACK")
    matchword(record count, 3, 6, "ERROR")
    !The reporting for the single track errors is appended to the
    !general tape error report.
    ste==array(conad+x'270', af track error)

    close list(0)=close list(0)+1
    close list(close list(0))=link
    select output(0)
    !MUST TIDY UP AT END OF RUN
    return 

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    code(13):
    !THIS IS THE CODE THAT PRODUCES A FILE(JCONTROLLER) CONTAINING ALL THE CONTROLLER
    !DUMPS FOR THE SPECIFIED PERIOD(OPTIONALLY TO A TERMINAL).
    !This analysis is specifically aimed at the ICL Engineers who will
    !BE ABLE TO REQUEST DUMPS OF GPC, DFC, SFC FROM THE PAST.
      cycle 
        prompt("*Output device:")
        read prompt reply(reply)
        if  reply= "HELP" then  print help(9) and  continue 
        if  reply -> ns1.("T").ns2 and  ns1="" then  reply=ns2 and  c 
          controller stream = 0 and  exit 
        print device = reply and  exit 
      repeat 
      if  print device # "" start 
        next stream=next stream+1
        controller stream=next stream
        define("STREAM".intostr(controller stream).",JCONTROLLER")
      finish 

      record count=record count+1
      prc == pattern(record count)
      prc_atoms=4
      prc_any atom=0
      prc_keywords=3
      prc_analysis no=3
      prc_link=1
      cycle 
        prompt("Type:")
        read prompt reply(reply)
        exit  if  reply="DFC" or  reply="GPC" or  reply="SFC" c 
          or  reply="ALL"
      repeat 
      if  reply="ALL" start 
        matchword(record count, 1, 1, "&&")
        matchword(record count, 2, 2, "DUMP")
        matchword(record count, 3, 3, "OF")
      finish  else  start 
        matchword(record count, 1, 2, "DUMP")
        matchword(record count, 2, 3, "OF")
        matchword(record count, 3, 4, reply)
      finish 
      printstring(jtxt."Controller dump printing initialised.")
      newline
      close list(0)=close list(0)+1
      close list(close list(0))=link
      return 

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    code(14):
    !THIS PRODUCES FULL REPORTS ON DISC DUMPS IN THE PERIOD FOR THE ENGINEERS.
    !IT CAN BE DIRECTED TO THE PRINTER OR A TERMINAL
    !THIS GIVES THE ENGINEERS THE FACILITY TO LOOK AT DISC TRANSFER
    !FAILURES IN MORE DETAIL THAN ON THE DAILY JOURNAL REPORT.
      cycle 
        prompt("*Output device:")
        read prompt reply(reply)
        if  reply = "HELP" then  print help(9) and  continue 
        if  reply -> ns1.("T").ns2 and  ns1="" then  reply=ns2 and  c 
          disc dump stream = 0 and  exit 
        print device = reply and  exit 
      repeat 
      if  print device # "" start 
        next stream=next stream+1
        disc dump stream=next stream
        define("STREAM".intostr(disc dump stream).",JDISC,1024")
      finish 

      record count=record count+1
      prc == pattern(record count)
      prc_atoms=10
      prc_any atom=0
      prc_keywords=3
      prc_analysis no=4
      prc_link=1
      matchword(record count, 1, 2, "DISC")
      matchword(record count, 2, 3, "TRANSFER")
      matchword(record count, 3, 8, "FAILS")
      close list(0)=close list(0)+1
      close list(close list(0))=link
      return 

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    code(15):
    !THE SYSTEM MANAGEMENT STATISTICS SECTION. UPDATES THE MANAGEMENT
    !INTERACTIVE DATABASE.
    return 


    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !  THE VOLUMS ANALYSIS.
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    code(21):
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !THE AUTOMATIC VOLUMES ANALYSIS
    !FIRSTLY THE AUTOMATIC ANALYSIS OF RESTORES FROM ARCHIVE.
    copy("JJ#VOLRWK,T#VOLRWK")
    connect("T#VOLRWK", 3, 0, 0, r, flag)
    if  flag#0 start 
      printstring(jtxt."Creating new restore analysis workfile.")
      newline
      outfile("T#VOLRWK", 4096, 0, 0, conad, flag)
      monitor  and  stop  if  flag#0
      integer(conad) = 4096
      integer(conad+8) = integer(conad)
      integer(conad+28) = 92; ! restore wk max.
      i = conad
    finishelse  i = r_conad
    restore wk entry==array(i+x'20', af restore wk entry)
    restore wk max == integer(i+28)

    connect("JJ#VOLRTAB", 3, 0, 0, r, flag)
    if  flag#0 start 
      printstring(jtxt."Creating new restore accumulation file (JJ#VOLRTAB).")
      newline
      create jfile("JJ#VOLRTAB", 766{cells}, 32, 48 {header size}, conad, flag)
      if  flag#0 start 
         printstring(jtxt."Unable to create JJ#VOLRTAB")
         newline
         stop 
      finish 
      restore head == record(conad)
      restore head_maxentries = 766
      restore table == array(conad+size of(restore head), af restore table)
    finishelsestart 
      restore head == record(r_conad)
      restore table == array(r_conad+size of(restore head), af restore table)
    finish 

    restore start date = restore head_restore start date
    restore end date = restore head_restore end date
    restore entries = restore head_restore entries

    !WE ARE NOW SET UP TO DEAL WITH RECORDING RESTORES.

    record count=record count+1
    prc == pattern(record count)
    !A RESTORE COMPLETED.
    prc_atoms=22
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=1
    prc_link=1
    matchword(record count, 1, 4, "RESTORE")
    matchword(record count, 2, 8, "E")

    record count=record count+1
    prc == pattern(record count)
    !A RESTORE IS REQUESTED.
    prc_atoms=8
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=1
    prc_link=2
    matchword(record count, 1, 4, "RESTORE")
    matchword(record count, 2, 5, "REQUEST")

    record count=record count+1
    prc == pattern(record count)
    !A RESTORE COMPLETION MESSAGE.
    prc_atoms=16
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=1
    prc_link=3
    matchword(record count, 1, 4, "MESSAGE")
    matchword(record count, 2, 6, "RESTORED""")

    record count = record count+1
    prc == pattern(record count)
    prc_atoms = 8
    prc_any atom = 0
    prc_keywords = 3
    prc_analysis no = 1
    prc_link = 4
    matchword(record count,1,6,"LOADED")
    matchword(record count,2,7,"NO")
    matchword(record count,3,8,"RING")

    record count=record count+1
    prc == pattern(record count)
    !A RESTORE COMPLETED.
    prc_atoms=16
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=1
    prc_link=5
    matchword(record count, 1, 6, "archive")
    matchword(record count, 2, 7, "of")

    record count=record count+1
    prc == pattern(record count)
    !A RESTORE IS REQUESTED.
    prc_atoms=8
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=1
    prc_link=6
    matchword(record count, 1, 4, "Restore")
    matchword(record count, 2, 5, "request")

    record count=record count+1
    prc == pattern(record count)
    !A RESTORE COMPLETION MESSAGE.
    prc_atoms=16
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=1
    prc_link=7
    matchword(record count, 1, 4, "Message")
    matchword(record count, 2, 6, "restored""")

    record count = record count+1
    prc == pattern(record count)
    prc_atoms = 8
    prc_any atom = 0
    prc_keywords = 3
    prc_analysis no = 1
    prc_link = 8
    matchword(record count,1,6,"loaded")
    matchword(record count,2,7,"no")
    matchword(record count,3,8,"ring")

    close list(0)=close list(0)+1
    close list(close list(0))=link
    return 


    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !  THE SPOOLR ANALYSIS.
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


    code(31):
    !THIS WILL BE THE FIRST SPOOLR ANALYSIS INITIALISATION.
    copy("JJ#SPIJOB,T#SPIJOB")
    connect("T#SPIJOB", 3, 0, 0, r, flag)
    if  flag#0 start 
      printstring(jtxt."Creating new incomplete-job stats file")
      newlines(2)
      create jfile("T#SPIJOB", 79 {cells}, 48 {cell size}, 304 {header size},
                   conad, flag)
      stop  if  flag#0
      ijob head == record(conad)
      ijob head_end = ijob head_size
      ijob head_maxcells = 79; ! 4096 bytes = 304 (header) + 79*48 (cells)
      ijob head_freen = ijob head_maxcells
      ijob head_freep = 1; ! pointer (index) to free list.
      cell == array(addr(ijob head)+ijob head_start, caf)
      for  i=1,1,ijob head_maxcells cycle 
         cell(i)_last = i-1; cell(i)_next = i+1
         cell(i)_user = "<FREE>"
      repeat 
      cell(ijob head_maxcells)_next = 0
      ! Now free list is set up.  Note that it is maintained in ascending order.
      r_conad = conad
    finish 
    ijob head == record(r_conad)
    listhead == ijob head_listhead
    freen == ijob head_freen
    freep == ijob head_freep
    maxcells == ijob head_maxcells
    ! Other header items can be referred to as ijob head_...

    cell == array(addr(ijob head)+ijob head_start, caf)

    ! Now connect file JJ#SPCJOB, creating it first if necessary.
    connect("JJ#SPCJOB", 3, 0, 0, r, flag)
    if  flag#0 start 
       printstring(jtxt."Creating new completed-job stats file.")
       newlines(2)
       create jfile("JJ#SPCJOB", 306 {cells}, 40 {cellsize}, 48 {header size},
                    conad, flag)
       ! Sets up _end, _start, _size in header.
       ! 306 entries of 40 bytes each.
       stop  if  flag#0
       cjob head == record(conad)
       cjob head_next job slot = 1
       cjob head_max job slots = 306
       r_conad = conad
    finish 

    cjob head == record(r_conad)
    start date = cjob head_start date
    end date = cjob head_end date
    next job slot = cjob head_next job slot
    max job slots == cjob head_max job slots
    job entry == array(addr(cjob head)+cjob head_start, af job entry)

    if  journalsite = kent then  start 
       copy("JJ#SPCONS,T#SPCONS")
       connect("T#SPCONS",3,0,0,r,flag)
       if  flag # 0 then  start 
          printstring(jtxt."Creating new consumables stats file")
          newlines(2)
          outfile("T#SPCONS",28*4096+x'40',0,0,conad,flag)
          monitor  and  stop  if  flag # 0
          integer(conad) = integer(conad+8)
          integer(conad+12) = 4;   ! DATA FILE
          integer(conad+24) = 3;   ! UN-STRUCTURED
          ucr == array(conad+x'40',af ucons entry)
          integer(conad+x'24') = 0;   ! START DATE
          integer(conad+x'28') = 0;   ! FINISH DATE
          connect("T#SPCONS",3,0,0,r,flag)
       finish 
       cons file addr = r_conad
       ucr == array(r_conad+x'40',af ucons entry)
       cstart date = integer(r_conad+x'24')
       cend date = integer(r_conad+x'28')
    finish 

!
!   Initialisation of NETLOG stream                               NETLOG

    next stream=next stream+1;                                  ! NETLOG
    netlog stream=next stream;                                  ! NETLOG
    define("STREAM".intostr(netlog stream).",NETLOG-MOD,1024"); ! NETLOG
!                                                                 NETLOG

    !WE ARE NOW SET UP TO DEAL WITH DETAILED ENTRIES ABOUT SPOOLR JOBS.
    !IN THE FORM: JOB SIZE/WAITING TIME/OWNER/DEVICE

    record count=record count+1
    prc == pattern(record count)

    prc_atoms=7
    prc_any atom=0
    prc_keywords=1
    prc_analysis no=1
    prc_link=1
    matchword(record count, 1, 7, "QUEUED")

    record count=record count+1
    prc == pattern(record count)

    prc_atoms=10
    prc_any atom=0
    prc_keywords=1
    prc_analysis no=1
    prc_link=2
    matchword(record count, 1, 7, "STARTED")

    record count=record count+1
    prc == pattern(record count)

    prc_atoms=12
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=1
    prc_link=3
    matchword(record count, 1, 9, "CHARGED")
    matchword(record count, 2, 12, "OUTPUT")

    record count=record count+1
    prc == pattern(record count)

    prc_atoms=13
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=1
    prc_link=4
    matchword(record count, 1, 9, "STARTED")
    matchword(record count, 2, 12, "TIME")

    record count=record count+1
    prc == pattern(record count)

    prc_atoms=17
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=1
    prc_link=5
    matchword(record count, 1, 4, "BATCH")
    matchword(record count, 2, 9, "ENDS")

!                                                         NETLOG
!   Accounts Record recognition for NETLOG stream         NETLOG
!                                                         NETLOG
    record count=record count+1;                        ! NETLOG
    prc == pattern(record count);                       ! NETLOG
!                                                         NETLOG
    prc_atoms=10;                                       ! NETLOG
    prc_any atom=0;                                     ! NETLOG
    prc_keywords=1;                                     ! NETLOG
    prc_analysis no=1;                                  ! NETLOG
    prc_link=6;                                         ! NETLOG
    matchword(record count, 1, 6, "A:");                ! NETLOG
!                                                         NETLOG
!   FTP record recognition for NETLOG stream              NETLOG
!                                                         NETLOG
    record count=record count+1;                        ! NETLOG
    prc == pattern(record count);                       ! NETLOG
!                                                         NETLOG
    prc_atoms=12;                                       ! NETLOG
    prc_any atom=0;                                     ! NETLOG
    prc_keywords=2;                                     ! NETLOG
    prc_analysis no=1;                                  ! NETLOG
    prc_link=7;                                         ! NETLOG
    matchword(record count, 1, 4, "FTP");               ! NETLOG
    matchword(record count, 2, 7, "ACCOUNT:");         ! NETLOG
!                                                         NETLOG

    close list(0)=close list(0)+1
    close list(close list(0))=link
    return 

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    code(32):
    !PRODUCE ON DEMAND A FULL REPORT ON THE BACKGROUND WORK DONE
    !FOR THE USER(S) SPECIFIED . OUTPUT TO THE LINE PRINTER.
    if  batch report stream=-1 start 
      next stream=next stream+1
      batch report stream=next stream
      define("STREAM".intostr(batch report stream).",JBATCHREP,1024")
    finish 
    batch user(i)="" for  i=1, 1, 20
    last batch user=""

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=7
    prc_any atom=0
    prc_keywords=1
    prc_analysis no=2
    prc_link=1
    matchword(record count, 1, 6, "DOCUMENT")

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=7
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=2
    prc_link=2
    matchword(record count, 1, 4, "BATCH")
    matchword(record count, 2, 7, "QUEUED")

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=7
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=2
    prc_link=3
    matchword(record count, 1, 4, "BATCH")
    matchword(record count, 2, 7, "UNQUEUED")

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=13
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=2
    prc_link=4
    matchword(record count, 1, 4, "BATCH")
    matchword(record count, 2, 9, "STARTED")

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=17
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=2
    prc_link=5
    matchword(record count, 1, 4, "BATCH")
    matchword(record count, 2, 9, "ENDS")
    cycle 
      prompt("Specific user:")
      read prompt reply(s)
      exit  if  s="ALL" or  s="END"
      i=0
      if  length(s)=6 start 
        for  i=1, 1, 20 cycle 
          if  batch user(i)=s start 
            printstring("Already specified!")
            newline
          finish  else  start 
            if  batch user(i)="" then  batch user(i)=s and  exit 
            if  i=20 start 
              printstring("Specific user list full(20 entries).")
              newline; exit 
            finish 
          finish 
        repeat 
      finish 
      exit  if  i=20
    repeat 
    if  s="ALL" then  batch ucount=-1 else  start 
      batch ucount=0
      for  i=1, 1, 20 cycle 
        exit  if  batch user(i)=""
        batch ucount=i
      repeat 
      if  batch ucount=0 start 
        printstring("Please define specific users!!!")
        newline ;return 
      finish 
    finish 
    close list(0)=close list(0)+1
    close list(close list(0))=link
    return 

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !  THE DIRECT LOG ANALYSIS.
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    code(51):
    !IE THE AUTOMATIC ANALYSIS OF DIRECT LOGS.
    copy("JJ#DIRSESS,T#DIRSESS")
    connect("T#DIRSESS", 3, 0, 0, r, flag)
    if  flag#0 start 
      !THE SESSIONS FILE DOES NOT ALREADY EXIST, CREATE IT.
      printstring(jtxt."Creating new sessions file."); newline
      outfile("T#DIRSESS", (max monthly sessions*28)+ c 
       (max proc slots*24)+x'60', 0, 0, conad, flag)
      if  flag#0 start 
        printstring(jtxt."Cannot create session file: " c 
          .intostr(flag))
        newline; stop 
      finish 
      sessions list==array(conad+x'50'+max proc slots*24,
       af sessions list)
      session total==integer(conad+x'20')
      session list start==integer(conad+x'24')
      session list end==integer(conad+x'28')
      session total=0; session list start=0;session list end=0
      session file connect=conad
      proc primary==array(conad+x'30', af proc slot)
      proc secondary==array(conad+x'40'+max proc slots*12,
        af proc slot)
      !SESSIONS LIST IS THE MAIN DATABASE FOR THE SESSION ANALYSES.
      !PROC PRIMARY AND SECONDARY ARE RETAINDED WORKFILES.
      for  i=4, 1, max proc slots cycle 
        proc primary(i)_user=""
        proc secondary(i)_user=""
      repeat 
    finish  else  start 
      !THE SESSIONS LIST FILE EXISTS ALREADY SO MAKE IT
      !UP TO FULL SIZE FOR THE DURATION OF THE ANALYSIS.
      disconnect("T#DIRSESS", flag)
      change file size("T#DIRSESS", (max monthly sessions*28) c 
        +(max proc slots*24)+x'60', flag)
      if  flag#0 start 
        printstring(jtxt."Change file size T#DIRSESS fails: " c 
          .intostr(flag))
        newline; stop 
      finish 
      connect("T#DIRSESS", 3, 0, 0, r, flag)
      if  flag#0 start 
        printstring(jtxt."Connect jsessions fails: ".intostr(flag))
        newline; stop 
      finish 
      session file connect=r_conad
      session total==integer(session file connect+x'20')
      session list start==integer(session file connect+x'24')
      session list end==integer(session file connect+x'28')
      sessions list==array(session file connect+max proc slots*24 c 
        +x'50', af sessions list)
      proc primary==array(session file connect+x'30', af proc slot)
      proc secondary==array(session file connect+x'40' c 
        +max proc slots*12, af proc slot)
    finish 
    !NOW DEFINE THE KEYS FOR ANALYSIS

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=11
    prc_any atom=0
    prc_keywords=1
    prc_analysis no=1
    prc_link=1
    matchword(record count, 1, 6, "ISTART:")

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=11
    prc_any atom=0
    prc_keywords=1
    prc_analysis no=1
    prc_link=2
    matchword(record count, 1, 6, "BSTART:")

    record count=record count+1
    prc == pattern(record count)
    prc_atoms=19
    prc_any atom=0
    prc_keywords=2
    prc_analysis no=1
    prc_link=3
    matchword(record count, 1, 6, "STOPS:")
    matchword(record count, 2, 18, "PROCS")
    close list(0)=close list(0)+1
    close list(close list(0))=link
    return 
  end ;  !OF ROUTINE INITIALISE ANALYSIS.


! ********************************************************************
  routine  close analyses
    !THIS ROUTINE CLEARS DOWN AT THE END OF THE RUN AND
    !DOES ANY IO REQUIRED.
    routinespec  update tape lib(stringname  dev, tsn, type, oper,
          integername  lvl)
    integer  link; link=0
    integer  i, j, k, l, m, n, errors, last int
    string (32) s, st, last st
    switch  close(1:60)

    routine  overflow info(integername  t errors, stringname  date, time)
       integer  i
       newpage
       newlines(5)
       printsymbol('*') for  i=1, 1, 130
       newlines(2)
       printstring("Note:  there were ".intostr(terrors))
       printstring(" over the period of which the first ")
       printstring(intostr(maxuniterrors)." are given above.")
       newline
       printstring("In order to get further error details you must")
       printstring(" do a 'MAINLOG SUMMARY' with option 'ALL SUMMARIES'")
       newline
       printstring("(see Journal documentation) for the period ".date."(")
       printstring(time.") onwards.")
       newlines(2)
       printsymbol('*') for  i=1, 1, 130
       return 
    end ;  !OF ROUTINE OVERFLOW INFO.

    next:
    link=link+1
    return  if  link>close list(0)
    !IE ALL ANALYSES TIDY.
    ->close(close list(link))

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11
    close(2):
      select output(0)
      close stream(general stream)
      deliver(sok delivery)
      if  sok file action=1 then  send("JJANL,.".print device)
      if  sok file action=2 then  list("JJANL,.".print device)
      deliver(own dlv)
      if  2<=sok file action<=3 and  sok offer to#"JOURNL" start 
        offer("JJANL", sok offer to, flag)
        if  flag#0 start 
          printstring(jtxt."Search on key output file offer fails")
          newlines(2)
        finish 
      finish 
      ->next


    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! CLOSE MAINLOG ANALYSES.
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    close(11):
!      CONNECT(CONTROL, 3, 0, 0, R, FLAG)
!      %IF FLAG#0 %THEN MASTER FILE FAILURE(CONTROL, FLAG)
!      INTEGER(R_CONAD+X'28')=ELB ERCOUNT
!      !IE AMEND THE CONTINUOUS ERROR COUNTER FOR ICL COMPATABLE FILE.
      !NOTE THAT BECAUSE THE TAPE LIBRARY UPDATING IS DONE AT THE
      !SAME TIME AS THE TAPE ERROR REPORTS, THE CLOSING OF THE LIBRARY
      !FILE OCCURS AFTER THE SECTION OF TAPE ERROR REPORTS
      !FURTHER DOWN THE CLOSE ROUTINE.
      ->next

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    close(12):
      !MAINLOG ANALYSIS AUTO/MANUAL.

      !------------------------------------------
      !CLOSE THE DISC ERROR REPORTING (MAKE REPORT)
      !AND LIST THE CONTROLLER DUMPS.
      select output(0)
!M*      PRINTSTRING("Closing disc report:")
!M*    METER(S)
      select output(0)
      close stream(controller stream)
      if  dfc dumps+gpc dumps+sfc dumps#0 start 
        deliver(icl dlv)
        list("JCONTROLLER,.LP")
        deliver(own dlv)
        send("JCONTROLLER,.LP")
      finish  else  destroy("JCONTROLLER", flag)
      select output(disc stream)
      newlines(2)
      !A MAXIMUM OF 2000 DISC ERRORS RECORDED ON ANY RUN.
      if  dec=0 start 
        newlines(2)
        printstring("No disc errors recorded.")
        newline
        errors=0
      finish  else  start 
        if  dec>max unit errors then  errors=max unit errors c 
        else  errors = dec
        for  j=1, 1, errors cycle 
          !LOOK AT EACH DISC ERROR.
          de==disc error(j)
          if  disc lines=50 start 
            newpage
            printstring("EMAS ".ocp desc(ocptype, systype)." Disc Error Report Page: ")
            write(disc page, 2)
            disc page=disc page+1
            disc 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.
               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")
               newline
               printsymbol('-') for  i=1,1,121
            finish 
            newlines(2)
          finish 
          printstring(de_date)
          printstring(" ")
          printstring(de_time)
          printstring("  ")
          printstring(de_dev)
          printstring("  ")
          printstring(de_media)
          for  k=1, 1, 20 cycle 
            if  disc(k)_device=de_dev start 
              disc(k)_fails=disc(k)_fails+1
              exit 
            finish 
            if  disc(k)_device="" start 
              disc(k)_device<-de_dev
              disc(k)_fails=1
              exit 
            finish 
            if  k=20 start 
              printstring(jtxt."Warning..more than 20 disc units!")
              newline
              exit 
            finish 
          repeat 
          !NOW WE HAVE UPDATED THE ENTRY THAT WILL GIVE FIGURES FOR
          !THE ENGINEERING ONE PAGE SUMMARY
          if  de_ertype="???" then  c 
            printstring("  ******record lost******") else  start 
            printstring("  ".de_route)
            if  systype = P series start 
               wstring=de_tcount."/".de_fcount
               spaces(14-length(wstring))
               printstring(wstring)
               spaces(2)
               printstring(de_stream0)
               printstring("  ")
               printstring(de_stream1)
               printstring("  ")
               printstring(de_cstatus)
               printstring(" ")
               if  de_ertype="BDS" then  printstring("?") else  spaces(1)
               printstring(de_s0t2)
               printstring(" ")
               printstring(de_t3t6)
               printstring(" ")
               printstring(de_m0m3)
               printstring("  ")
               printstring(de_faillbe)
               printstring("  ")
               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_failtcb." ".de_cylinf)
            finish 
          finish 
          newlines(1)
          disc lines=disc lines+1
        repeat 
        finish 
      if  dec>max unit errors then  overflow info(dec, dec date, dec time)
      select output(0)
      close stream(disc stream)
      deliver(own dlv)
      if  engineer special=off and  dec#0 c 
      then  send("JDISCERRORS,.LP") else  destroy("JDISCERRORS",flag)
      !NOW WE AMEND THE HEADER VALUES TO THE KNOWN ACTUAL FILE
      !LENGTH OF THE DISC WORK FILE AND RECORD THE TOTAL NUMBER OF ERRORS FOUND
      !IN THE EIGHTH HEADER WORD.
      connect("JDISC", 3, 0, 0, r, flag)
      monitor  and  stop  if  flag#0
      integer(r_conad+x'1C')=dec
      !IE THE TOTAL ERRORS
      integer(r_conad)=x'40'+errors*133
      integer(r_conad+x'08')=((integer(r_conad))>>12+1)<<12
      string(r_conad+x'20')=dec date
      string(r_conad+x'30')=dec time
      disconnect("JDISC", flag)

      !---------------------------------------------
      !CLOSE THE SMAC ERROR REPORTING.
      select output(0)
!M*      PRINTSTRING("Closing smac report:")
!M*    METER(S)
      select output(smac stream)
      newlines(2)
      if  sec=0 start 
        printstring("No smac errors recorded.")
        newline
        errors=0
      finish  else  start 
        if  sec>max unit errors then  errors=max unit errors c 
        else  errors = sec
        for  j=1, 1, errors cycle 
          smac record==smac error(j)
          if  smac lines=50 start 
            newpage
      printstring("EMAS ".ocp desc(ocptype, systype)." SMAC Error Report Page:")
            write(smac page, 3)
            smac page=smac page+1
            smac lines=0
            newlines(2)
            printstring("   DATE      TIME      SMAC   POINTER ")
            printstring("  ADDRESS   ENG STATE  STATUS    CONFIG")
            printstring("   SEI PARAM   DATA")
            newline
            printsymbol('-') for  k=1, 1, 108
            newlines(2)
          finish 
          spaces(1)
          printstring(smac record_date."  ".smac record_time)
          spaces(5)
          printstring(smac record_smac."     ".smac record_pointer)
          printstring("  ".smac record_address."  ")
          printstring(smac record_eng state."  ")
          printstring(smac record_status."  ".smac record_config)
          printstring("  ".smac record_sei param)
          printstring("  ".smac record_data)
          !NOW UPDATE THE TABLE THAT WILL GIVE THE FINAL FIGURES
          !FOR THE ENGINEERING ONE PAGE SUMMARY
          st="SMAC ".smac record_smac
          for  k=1, 1, 20 cycle 
            if  smac(k)_device=st start 
              smac(k)_fails=smac(k)_fails+1
              exit 
            finish 
            if  smac(k)_device="" start 
              smac(k)_device<-st
              smac(k)_fails=1
              exit 
            finish 
            if  k=20 start 
              printstring(jtxt."Warning, more than 20 smacs!")
              newline
              exit 
            finish 
          repeat 
          !TABLE UPDATED.
          newlines(2)
          smac lines=smac lines+2
        repeat 
      finish 
      if  sec>maxuniterrors then  overflow info(sec, sec date, sec time)
      select output(0)
      close stream(smac stream)
      deliver(own dlv)
      if  engineer special=off and  sec#0 then  c 
      send("JSMACERRORS,.LP") else  destroy("JSMACERRORS",flag)
      !NOW AMEND THE HEADER OF WORK FILE JSMAC PRIOR TO ITS BEING
      !ADDED TO THE INTERACTIVE ENGINEERING DATA BASE.
      connect("JSMAC", 3, 0, 0, r, flag)
      monitor  and  stop  if  flag#0
      integer(r_conad+x'1C')=sec
      integer(r_conad)=x'40'+errors*91
      integer(r_conad+x'08')=((integer(r_conad))>>12+1)<<12
      string(r_conad+x'20')=sec date
      string(r_conad+x'30')=sec time
      disconnect("JSMAC", flag)

      !-------------------------------------------
      !CLOSE THE DRUM ERROR REPORTING.
      select output(0)
!M*      PRINTSTRING("Closing drum report:")
!M*    METER(S)
      select output(drum stream)
      newlines(2)
      if  drec=0 start 
        printstring("No drum errors recorded")
        newlines(2)
        errors=0
      finish  else  start 
        if  drec>max unit errors then  errors=max unit errors c 
        else  errors=drec
        for  j=1, 1, errors cycle 
          drum record==drum error(j)
          if  drum lines>=56 start 
            newpage
            printstring("EMAS ".ocpdesc(ocptype, systype)." Drum Error Report Page:")
            write(drum page, 3)
            drum page=drum page+1
            drum 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 
          !NOW UPDATE THE TABLE THAT WILL GIVE THE FINAL FIGURES FOR
          !THE ONE PAGE ENGINEERING SUMMARY.
          for  i=1, 1, 20 cycle 
            if  drum(i)_device=drum record_route start 
              drum(i)_fails=drum(i)_fails+1
              exit 
            finish 
            if  drum(i)_device="" start 
              drum(i)_device<-drum record_route
              drum(i)_fails=1
              exit 
            finish 
            if  i=20 start 
              printstring(jtxt."Warning, more than 20 drums!")
              newline
              exit 
            finish 
          repeat 
          !TABLE UPDATED.
          spaces(1)
          if  drum record_ertype="??" start 
            printstring("********record lost*********")
            drum lines=drum lines+2
          finish  else  start 
            printstring(drum record_date." ".drum record_time)
            spaces(9-length(drum record_route))
            printstring(drum record_route."  ".drum record_ertype)
            for  i=0, 1, 4 cycle 
              printstring(" ".drum record_stream(i))
            repeat 
            for  i=1, 1, epage cycle 
              if  i#1 then  newline and  spaces(78)
              printstring(" ".drum record_drum sector(i)_word1)
              printstring(" ".drum record_drum sector(i)_word2)
              printstring(" ".drum record_drum sector(i)_desc)
            repeat 
            drum lines=drum lines+epage+2
          finish 
          newlines(2)
        repeat 
      finish 
      if  drec>maxuniterrors then  overflowinfo(drec, drec date, drectime)
      select output(0)
      close stream(drum stream)
      deliver(own dlv)
      if  engineer special=off and  drec#0 then  c 
      send("JDRUMERRORS,.LP") else  destroy("JDRUMERRORS",flag)
      !NOW AMEND THE HEADER OF THE WORK FILE JDRUM TO GIVE THE REAL
      !LENGTH OF THE WORK FILE BEFORE BEING USED TO UPDATE THE
      !ENGINEERING INTERACTIVE DATABASE.
      connect("JDRUM", 3, 0, 0, r, flag)
      monitor  and  stop  if  flag#0
      integer(r_conad+x'1C')=drec
      integer(r_conad)=x'40'+errors*483
      integer(r_conad+x'08')=((integer(r_conad))>>12+1)<<12
      string(r_conad+x'20')=drec date
      string(r_conad+x'30')=drec time
      disconnect("JDRUM", flag)

      !-------------------------------------------------
      !CLOSE THE TAPE ERROR REPORTING AND MAKE REPORTS.
      last int=21; last st=""
      select output(0)
!M*      PRINTSTRING("Closing tape report:")
!M*    METER(S)
      select output(tape stream)
      if  tec=0 then  errors=0 else  start 
      if  tec>max unit errors then  errors=max unit errors c 
      else  errors=tec
      for  j=1, 1, errors cycle 
        tape record a==tape error(j)
        if  tape lines=50 start 
          tape lines=0
          newpage
        printstring("EMAS ".ocpdesc(ocptype, systype)." Tape Error Report Page:")
          write(tape page, 2)
          tape page=tape page+1
          newlines(2)
          printstring("  DATE      TIME    DEV  MEDIA   OP.  FAIL")
          printstring("  LVL SINCE LAST IPL  STREAM RESPONSE--")
          printstring(" STREAM STATUS:"); spaces(26)
          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 
        k=21
        if  tape recorda_t8t11="********" or  c 
          tape recorda_media="******" then  ->skip mt
        if  last st=tape recorda_dev then  k=last int else  start 
          for  k=1, 1, 20 cycle 
            deck record==deck errors(k)
            if  deck record_deck=tape record a_dev then  exit 
            !THERE EXISTS AN ENTRY FOR THIS DECK IN THE TABLES.
            if  deck record_deck="" start 
              !MAKE AN ENTRY FOR THIS DECK.
              deck record_deck<-tape record a_dev
              exit 
            finish 
            if  k=20 start 
              printstring(jtxt."Too many tape decks(>20)!!")
              newline
              k=21
              exit 
            finish 
          repeat 
          last st=tape recorda_dev; last int=k
        finish 
        if  k<21 start 
          if  charno(tape record a_t12t15,8)='0' start ; ! MTS deck.
             hex to bin(tape record a_t8t11, l)
             l = (l>>16)&x'2FF'; ! T8 (2 bits) + T9.
          finishelsestart ; ! GTS deck.  Construct a word sim. to MTS format.
             st = substring(tape record a_t8t11,1,2); ! T8.
             hextobin(st,l)
             st = substring(tape record a_t12t15,3,4)
             hextobin(st,n)
             l = 1<<9!l if  n&16#0; ! I.e. if parity track bit set.
          finish 
          ->skip mt if  l=0
          n=l
          cycle 
            exit  if  n=0
            if  n&1#0 start 
              n=n>>1
              if  n=0 then  ->single track
              exit 
            finish 
            n=n>>1
         repeat 
          !TO GET HERE WE HAVE A MULTI TRACK FAIL
          if  (l>>8)&x'02'#0 then  mte(k)_trk(8)=mte(k)_trk(8)+1
          for  m=0, 1, 7 cycle 
            if  l&(1<<m)#0 then  mte(k)_trk(m)=mte(k)_trk(m)+1
          repeat 
          for  l=1, 1, 100 cycle 
            if  mte(k)_tsns(l)_tsn=tape record a_media then  exit 
            !THE TAPE IS ALREADY IN THE FAIL LIST FOR THIS DECK.
            if  mte(k)_tsns(l)_tsn="" start 
              mte(k)_tsns(l)_tsn<-tape record a_media
              exit 
            finish 
            if  l=100 start 
              printstring(jtxt.">100 tapes failed on deck: ")
              printstring(" ".deck errors(k)_deck)
              newline
              l=101
              exit 
            finish 
          repeat 
          if  l<101 then  mte(k)_tsns(l)_events=mte(k)_tsns(l)_events+1
          ->skip mt
single track:
          if  (l>>8)&x'02'#0 then  ste(k)_trk(8)=ste(k)_trk(8)+1
          for  m=0, 1, 7 cycle 
            if  l&(1<<m)#0 then  ste(k)_trk(m)=ste(k)_trk(m)+1
          repeat 
          for  l=1, 1, 100 cycle 
            if  ste(k)_tsns(l)_tsn=tape record a_media then  exit 
            !THE TAPE IS ALREADY IN THE FAIL LIST FOR THIS DECK.
            if  ste(k)_tsns(l)_tsn="" start 
              ste(k)_tsns(l)_tsn<-tape record a_media
              exit 
            finish 
            if  l=100 start 
              printstring(jtxt.">100 tapes failed on deck: ")
              printstring(" ".deck errors(k)_deck)
              newline
              l=101
              exit 
            finish 
          repeat 
          if  l<101 then  ste(k)_tsns(l)_events=ste(k)_tsns(l)_events+1
        finish 
skip mt:
        printstring(tape record a_date."  ".tape record a_time)
        printstring("  M".tape record a_dev."  ".tape record a_media)
        printstring(" ".tape record a_oper)
        if  tape record a_oper="READ" then   spaces(1)
        printstring(" ".tape record a_type)
        hex to bin(tape record a_failures, winteger)
        winteger=winteger&x'0000FFFF'
        if  tape record a_media#"******" and  k<21 and  0<winteger<17 c 
        start 
          if  full run=on then  c 
            update tape lib(tape record a_dev, tape record a_media,
            tape record a_type, tape record a_oper, winteger)
          !WE DO NOT UPDATE THE TAPE LIBRARY DURING A CALL OF
          !ENGINEER CURRENT MAINLOG ANALYSIS.
          l=-1;  !INITIALISE.
          if  tape record a_oper="WRITE" then  l=1
          if  tape record a_oper="READ" then  l=0
          if  l#-1 start ;  !IE EITHER READ OR WRITE.
            if  tape record a_type="UNRC" then  c 
            tape fail levels(k, l, 16)=tapefail levels(k, l, 16)+1 c 
            else  tapefail levels(k, l, winteger)= c 
            tape fail levels(k, l, winteger)+1
          finish 
        finish 
        write(winteger, 3)
        hex to bin(tape record a_transfers, winteger)
        wstring1=intostr(winteger)
        hex to bin(tape record a_failures, winteger)
        winteger=winteger>>16
        wstring1=wstring1."/".intostr(winteger)
        spaces(16-length(wstring1))
        printstring(wstring1."  ")
        printstring(tape record a_stream0." ".tape record a_stream1)
        printstring(" ".tape record a_s0." ".tape record a_t0t3)
        printstring(" ".tape record a_t4t7." ".tape record a_t8t11)
        printstring(" ".tape record a_t12t15."  ".tape record a_fail lbe)
        newline
        tape lines=tape lines+1
      repeat 
      finish 
      if  single trk hr errors#0 or  tec#0 start 
      for  j=1, 1, 20 cycle 
        deck record==deck errors(j)
        exit  if  deck record_deck=""
        !NO MORE DECKS TO REPORT FAILURES ON
        newpage
        printstring("EMAS ".ocpdesc(ocptype, systype).":  Error report for ")
        printstring("tape deck: M")
        printstring(deck record_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)
         stej == ste(j)
        for  l=8, -1, 0 cycle 
          write(stej_trk(l), 5)
        repeat 
        m=0; spaces(2)
        for  l=1, 1, 100 cycle 
          exit  if  stej_tsns(l)_tsn=""
          m=m+1
          s="  ".stej_tsns(l)_tsn."("
          s=s.intostr(stej_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)
        mtej == mte(j)
        for  l=8, -1, 0 cycle 
          write(mtej_trk(l), 5)
        repeat 
        m=0; spaces(2)
        for  l=1, 1, 100 cycle 
          exit  if  mtej_tsns(l)_tsn=""
          m=m+1
          s="  ".mtej_tsns(l)_tsn."("
          s=s.intostr(mtej_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(deck record_ct(0, 0), 5); spaces(2)
        write(deck record_ct(1, 0), 5); spaces(2)
        write(deck record_ct(2, 0), 5)
        newlines(2)
        printstring("Unrecovered :"); spaces(3)
        write(deck record_ct(0, 1), 5); spaces(2)
        write(deck record_ct(1, 1), 5); spaces(2)
        write(deck record_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".deck record_deck)
        newlines(2)
      repeat 
      finish 
      if  tec>maxuniterrors then  overflow info(tec, tec date, tec time)
      select output(0)
      close stream(tape stream)
      deliver(own dlv)
      if  engineer special=off and  (tec#0 or  single trkhrerrors#0) c 
      then  send("JTAPEERRORS,.LP") else  destroy("JTAPEERRORS",flag)
      !NOW AMEND THE HEADER OF THE FILE TO REFLECT THE ACTUAL
      !LENGTH OF THE FILE AND ADD A COUNT OF THE ERRORS TO THE EIGHTH WORD.
      connect("JTAPE", 3, 0, 0, r, flag)
      monitor  and  stop  if  flag#0
      integer(r_conad+x'1C')=tec
      integer(r_conad+x'10')=single trk hr errors
      integer(r_conad)=x'6300';  !Ie spaces for ste's
      if  tec#0 then  integer(r_conad) = x'cd90'+(errors+20)*126
      !Ie room for mte's and errors.
      integer(r_conad+x'08') = ((integer(r_conad)-1)>>12+1)<<12
      string(r_conad+x'20')=tec date
      string(r_conad+x'30')=tec time
      disconnect("JTAPE", flag)

      !------------------------------------------------------------
      !DEAL WITH THE ICL COMPATIBLE ERROR FILE IF AN ACUMULATING RUN.
!      %IF FULL RUN=ON %THEN %START
!        !THIS RUN UPDATED THE ICL ERROR ACCUMULATION FILE.
!        INTEGER(ELB BASE+X'14')=PACK DATE AND TIME(DATE, TIME)
!        INTEGER(ELB BASE+X'18')=X'FFFFFF04'
!        INTEGER(ELB BASE)=ELB ADDR-ELB BASE
!        DISCONNECT("ICLERROR", FLAG)
!        SEND("ICLERROR,.JOURNAL")
!        CONNECT("ICLERROR", 0, 0, 0, R, FLAG)
!        %IF FLAG=0 %THEN %START
!          PRINTSTRING(jtxt." failed to send icl error file!!")
!          NEWLINE
!        %FINISH
!      %FINISH

      !-------------------------------------------------------------
      !MAKE UP THE ONE PAGE ENGINEERING SUMMARY IF THIS IS
      !A FULL RUN OF THE ANALYSIS(IE THE DAILY RUN)AND UPDATE THE
      !ENGINEERING PD FILE WITH THE HARDWARE REPORTS.
      select output(0)
!M*      PRINTSTRING("Making one page eng summary:")
!M*    METER(S)
      if  full run=off and  engineer special=off then -> next
      !ALLOW ENGINEER SPECIAL THROUGH.
      next stream=next stream+1
      define("STREAM".intostr(next stream).",JSUM")
      select output(next stream)
      newpage
      printsymbol('-') for  j=1, 1, 70
      newline
      if  engineer special=off start 
        printstring("EMAS ".ocpdesc(ocptype, systype)." Summary for period ")
        printstring(unpackdate(index entry(low file)_starting)."(")
        printstring(unpacktime(index entry(low file)_starting).") TO ")
        printstring(unpackdate(index entry(high file)_finishing)."(")
        printstring(unpacktime(index entry(high file)_finishing).")")
        newlines(2)
      finish 
      if  smac(1)_device="" then  c 
        printstring("No SMAC errors recorded") else  start 
        printstring("SMAC errors: ")
        k=0
        for  j=1, 1, 20 cycle 
          exit  if  smac(j)_device=""
          if  k=3 start 
            k=0;newline;spaces(13)
          finish 
          st=smac(j)_device."(".intostr(smac(j)_fails).")"
          printstring(st)
          spaces(14-length(st))
          k=k+1
        repeat 
      finish 
      newline
      if  sec>max unit errors start 
        printstring("***SMAC error overflow, see terminal report***")
        newline
      finish 
      if  drum(1)_device="" then  c 
       printstring("No drum errors recorded.") else  start 
        printstring("Drum errors: ")
        k=0
        for  j=1, 1, 20 cycle 
          exit  if  drum(j)_device=""
          if  k=3 start 
            k=0;newline;spaces(13)
          finish 
          st=drum(j)_device."(".intostr(drum(j)_fails).")"
          printstring(st)
          spaces(14-length(st))
          k=k+1
        repeat 
      finish 
      newline
      if  drec>max unit errors start 
        printstring("***Drum error overflow, see terminal report***")
        newline
      finish 
      if  disc(1)_device="" then  c 
        printstring("No disc errors recorded.") else  start 
        printstring("Disc errors: ")
        k=0
        for  j=1, 1, 20 cycle 
          exit  if  disc(j)_device=""
          if  k=3 start 
            k=0;newline;spaces(13)
          finish 
          st=disc(j)_device."(".intostr(disc(j)_fails).")"
          printstring(st)
          spaces(14-length(st))
          k=k+1
        repeat 
      finish 
      newline
      if  dec>max unit errors start 
        printstring("***Disc error overflow, see terminal report***")
        newline
      finish 
      if  tec=0 then  printstring("No tape errors recorded.") c 
      else  start 
        printstring("Tape errors(rc/unr): ")
        connect("JTAPE", 0, 0, 0, r, flag)
        monitor  and  stop  if  flag#0
        deck errors==array(r_conad+x'40', af deck errors)
        m=0
        for  j=1, 1, 20 cycle 
          exit  if  deck errors(j)_deck=""
          if  m=3  start 
            m=0;newline;spaces(21)
          finish 
          st="M".deck errors(j)_deck."("
          k=0
          for  l=0, 1, 2 cycle 
            k=k+deck errors(j)_ct(l, 0)
          repeat 
          st=st.intostr(k)."/"
          k=0
          for  l=0, 1, 2 cycle 
            k=k+deck errors(j)_ct(l, 1)
          repeat 
          st=st.intostr(k).")"
          printstring(st)
          spaces(17-length(st))
          m=m+1
        repeat 
        disconnect("JTAPE", flag)
      finish 
      newline
      if  tec>max unit errors start 
        printstring("***Tape error overflow, see terminal report***")
        newline
      finish 
      if  single trk hr errors=0 then  c 
      printstring("No single track(hardware recovered) errors.") c 
      else  start 
        printstring("Single track(hardware rec) errors: ")
        printstring(intostr(singletrkhrerrors))
      finish 
      newline
      if  dfc dumps=0 then  printstring("No DFC dumps recorded.") c 
      else  start 
        printstring("Total DFC errors: ")
        write(dfc dumps, 5)
      finish 
      newline
      if  sfc dumps=0 then  printstring("No SFC dumps recorded.") c 
      else  start 
        printstring("Total SFC errors: ")
        write(sfc dumps, 5)
      finish 
      newline
      if  gpc dumps=0 then  printstring("No GPC dumps recorded.") c 
      else  start 
        printstring("Total GPC errors: ")
        write(gpc dumps, 5)
      finish 
      newlines(2)
      printsymbol('-') for  j=1, 1, 70
      newline
      select output(0)
      close stream(next stream)
      if  engineer special=on then  ->next
      !WE HAVE DONE AS MUCH AS THE SPECIAL ENGINEERING RUN
      !REQUIRES OF THE FULL ANALYSIS.

      !---------------------------------------------------------------
      !NOW UPDATE THE ENGINEERING PD FILE. THIS FILE FORMS THE BASIS
      !OF THE INTERACTIVE ENGINEERING DIAGNOSTICS.
      select output(0)
!M*      printstring("Updating engineer data pd:")
!M*    METER(S)
      connect("JENGPD", 0, 0, 0, r, flag)
      if  flag#0 start 
         printstring(jtxt."Engineering file lost!.")
         newline
         printstring("          Creating a new file.")
        newline
        newpdfile("JENGPD")
        cherish("JENGPD")
        outfile("JENGHD", 1*4096, 0, 0, conad, flag)
        monitor  and  stop  if  flag#0
        integer(conad)=x'1000'
        integer(conad+8)=x'1000'
        eng hd==record(conad+x'20')
        ! Get ocptype and systype from comms record, if not already set.
        ! These are stored in JENGPD_JENGHD and used subsequently as defaults.
        systype = com_systype if  systype<0
        systype = 1 if  systype>0
        integer(conad+x'FC')=systype
        ocptype = com_ocptype if  ocptype<0
        integer(conad+x'100')=ocptype
        ! eng hd_entry(n)_next=0 %for n=1, 1, 10 (New file, so zeroed already)
        eng hd_first=0
        disconnect("JENGHD", flag)
        copy("JENGHD,JENGPD_JENGHD")
        destroy("JENGHD", flag)
      finish 
      copy("JENGPD_JENGHD,JENGHD")
      connect("JENGHD", 3, 0, 0, r, flag)
      if  flag#0 start 
        printstring(jtxt."Failed to copy engineering header file JENGPD_JENGHD.")
        newlines(2)
        stop 
      finish 
      eng hd==record(r_conad+x'20')
      integer(r_conad+x'FC')=systype
      integer(r_conad+x'100')=ocptype
      n=eng hd_first
      if  n#0 start 
        !!THIS IS NOT THE FIRST RUN WITH THIS PD.
        cycle 
          j=eng hd_entry(n)_next
          if  j=0 then  j=n and  exit 
          n=j
        repeat 
        n=n+1
        if  n=11 then  n=1
        !THIS IS WHERE THE NEXT ENTRY WILL BE
        disconnect("JENGPD", flag)
      finish  else  n=1
      disconnect("JENGPD", flag)
      ss=intostr(n)
      pdfiles(1) = "JSUM".ss
      pdfiles(2) = "JTAPE".ss
      pdfiles(3) = "JDISC".ss
      pdfiles(4) = "JSMAC".ss
      pdfiles(5) = "JDRUM".ss
      rename("JSUM,".pdfiles(1))
      rename("JTAPE,".pdfiles(2))
      rename("JDISC,".pdfiles(3))
      rename("JSMAC,".pdfiles(4))
      rename("JDRUM,".pdfiles(5))
      new members("JENGPD", 5, pdfiles, pdfileflags, flag)
      for  i=1, 1, 5 cycle 
        unless  pdfileflags(i) =0 or  pdfileflags(i)=288 then  flag=1
      repeat 
      if  flag#0 start 
        printstring(jtxt."Cannot update JEF database ".intostr(n))
        newline
        stop 
     finish 
      for  i=1, 1, 5 cycle 
      destroy(pdfiles(i), flag)
      repeat 
      if  eng hd_first#0 then  eng hd_entry(j)_next=n
      eng hd_entry(n)_from<-index entry(low file)_starting
      eng hd_entry(n)_to<-index entry(high file)_finishing
      eng hd_entry(n)_next=0
      if  n=eng hd_first start 
        n=n+1
        if  n=11 then  n=1
        eng hd_first=n
      finish 
      if  eng hd_first=0 then  eng hd_first=1
      disconnect("JENGHD", flag)
      copy("JENGHD,JENGPD_JENGHD")
      destroy("JENGHD", flag)

      !--------------------------------------------------------
      !NOW CLEAR UP THE TAPE LIBRARY FILE BY COPYING THE NEW FILE
      !WITH THE LENGTH HEADER AMENDMENT(TO SAVE SPACE) INTO THE
      !ENGINEERING DATA PARTITION FILE 'JENGPD'
      select output(0)
!M*      PRINTSTRING("Newgening tape library file:")
!M*    METER(S)
      tl fn date=log finish;  !IE THE END DATE/TIME OF THE LAST ANALYSED MAINLOG.
      i=(x'100'+tl rec count*576)
      integer(tape library addr)=i
      integer(tape library addr+4)=x'20'
      integer(tape library addr+8)=(i>>12+1)<<12
      disconnect("JTAPELIB", flag)
      if  flag#0 start 
        printstring(jtxt."Failed to disconnect tape library file.")
        printstring(", flag:".intostr(flag)); newlines(2)
      finish 
      copy("JTAPELIB,JENGPD_JTAPELIB")
      destroy("JTAPELIB", flag)
      !END OF TAPE LIBRARY HANDLING.
      ->next

      routine  update tape lib(stringname  dev, tsn, type, oper,
          integername  lvl)
      owninteger  last di=21
      ownstring (8) last dv=""
      owninteger  last tsni=0
      ownstring (8) last tsn=""
      integer  i, j, k; string (6) device
      return  unless  0<length(tsn)<=6 and  length(dev)<=2
      device="M".dev
      if  last dv#device start 
        for  i=1, 1, 20 cycle 
          exit  if  deck identity(i)_id=device
          if  deck identity(i)_id="" then  deck identity(i)_id<-device c 
            and  deck identity(i)_date<-log start and  exit 
          if  i=20 start 
            printstring(jtxt."Warning, >20 tape decks!!")
            newline
            return 
          finish 
        repeat 
        last di=i
        last dv=device
      finish  else  i=last di
      if  deck identity(i)_date=0 then  deck identity(i)_date<-log start
      if  tl rec count=0 start 
        tl rec count=1
        tape lib(1)_tsn<-tsn
        tape lib(1)_date<-log start
        j=1
      finish  else  start 
        if  tl rec count>tl max start 
          if  tl max flag=0 start 
             printstring(jtxt.">".intostr(tl max)." tapes in the library!!")
             newline
             tl max flag = 1
          finish 
          return 
        finish 
        if  last tsn=tsn then  j=last tsni else  start 
          for  j=1, 1, tl rec count cycle 
            if  tape lib(j)_tsn=tsn then  exit 
            if  tape lib(j+1)_tsn="" start 
              j = j+1
              tape lib(j)_tsn<-tsn
              tape lib(j)_date<-log start
              for  k=1, 1, 20 cycle 
                tle==tape lib(j)_deck(k)
                tle=0
                tle_mounts=1
              repeat 
              tl rec count=j
              tape lib(j)_deck(i)_mounts=1
              exit 
            finish 
          repeat 
          last tsn=tsn
          last tsni=j
        finish 
      finish 
      tape lib(j)_last used = tl current run
      if  tape lib(j)_date=0 then  tape lib(j)_date<-log start
      if  type="UNRC" start 
        if  oper="READ" then  tape lib(j)_deck(i)_read unrcvrd= c 
          tape lib(j)_deck(i)_read unrcvrd+1
        if  oper="WRITE" then  tape lib(j)_deck(i)_write unrcvrd= c 
          tape lib(j)_deck(i)_write unrcvrd+1
        return 
      finish 
      if  oper="READ" start 
        tape lib(j)_deck(i)_read rcvrd=tape lib(j)_deck(i)_read rcvrd+1
        tape lib(j)_deck(i)_rrtot=tape lib(j)_deck(i)_rrtot+lvl
      finish 
      if  oper="WRITE" start 
        tapelib(j)_deck(i)_write rcvrd=tape lib(j)_deck(i)_write rcvrd+1
        tape lib(j)_deck(i)_wrtot=tape lib(j)_deck(i)_wrtot+lvl
      finish 
      end ;  !OF ROUTINE UPDATE TAPE LIB.


    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    close(13):
      !CLOSE THE CONTROLLER DUMP FILE AND SEND TO THE PRINTER.
      select output(controller stream)
      if  controller stream#0 start 
        select output(controller stream)
        newlines(2)
        printstring("End of controller dump.")
        newpage
        select output(0)
        close stream(controller stream)
        if  dfc dumps+sfc dumps+gpc dumps=0 start 
          printstring(jtxt."No controller errors found.")
         newlines(2)
          destroy("JCONTROLLER", flag)
        finish  else  start 
          deliver(icl dlv)
          send("JCONTROLLER,.".print device)
          deliver(own dlv)
        finish 
      finish 
      ->next

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    close(14):
      !CLOSE THE ENGINEERING FULL DISC DUMP REPORTING.
      if  disc dump stream#0 start 
        select output(disc dump stream)
        newlines(2)
        printstring("End of disc dump analysis")
        newpage
        select output(0)
        close stream(disc dump stream)
        deliver(icl dlv)
        send("JDISC,.".print device)
        deliver(own dlv)
      finish 
      printstring(jtxt."End of analysis.")
      newline
      ->next

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !CLOSE THE VOLUMES ANALYSES.
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    close(21):
      !CLOSING THE AUTOMATIC VOLUMES ANALYSES.
      j = 0
      disconnect("T#VOLRWK", flag)
      disconnect("JJ#VOLRWK", flag)
      newgen("T#VOLRWK", "JJ#VOLRWK", flag)
      if  restore start date#0 start 
         s = unpack date(restore end date)
         j = 1 if  ("02"<substring(s,1,2)<"06" and  c 
           minutes between(restore start date, restore end date)>60*24*7)
         ! i.e. do analysis if not done for 7 days and the current day of the
         ! month is in the range 3-5.
      finish 
      restore head_restore start date = restore start date
      restore head_restore end date = restore end date
      restore head_restore entries = restore entries
      disconnect("JJ#VOLRTAB", flag)
      restore analysis("") if  flag=0 and  j=1
      ->next


    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !CLOSE SPOOLR ANALYSES.
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    close(31):
      !CLOSE THE SPOOLR STATISTICAL ANALYSIS.
      reduce ijob; ! Tidies and reduces (if possible) file T#SPIJOB.
      s = unpack date(end date)
      if  minutes between(start date, end date)>60*24*15 c 
         and  "02"<=substring(s,1,2)<="04" then  j=1 else  j=0
      disconnect("T#SPIJOB", flag)
      disconnect("JJ#SPIJOB", flag)
      newgen("T#SPIJOB","JJ#SPIJOB",flag)

      cjob head_start date = start date
      cjob head_end date = end date
      cjob head_next job slot = next job slot
      disconnect("JJ#SPCJOB", flag)

      if  journalsite = kent then  start 
         integer(cons file addr+x'24') = cstart date
         integer(cons file addr+x'28') = cend date
         disconnect("T#SPCONS",flag)
         disconnect("JJ#SPCONS",flag)
         newgen("T#SPCONS","JJ#SPCONS",flag)
if  flag # 0 then  rename("T#SPCONS,JJ#SPCONS")
      finish 

      output and background analyses("MONTHLY AUTORUN") if  j=1

!                                                         NETLOG
!     Close NETLOG stream                                 NETLOG
      selectoutput(0);                                  ! NETLOG
      close stream(netlog stream);                      ! NETLOG
!                                                         NETLOG

      ->next

    close(32):
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !CLOSE THE ON DEMAND CHRONOLOGICAL BATCH REPORT.
    select output(0)
    close stream(batch report stream)
    send("JBATCHREP,.LP")
    ->next

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !CLOSE THE DIRECT ANALYSES.
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    close(51):
    !CLOSE THE AUTO ANALYSIS.

    s = unpackdate(session list end)
    j = 0
    j = 1 if  (minutes between(session list start, session list end)>60*24*7 c 
      and  substring(s,1,2) < "05") or  c 
      session total>((max monthly sessions*95)//100) 
    !IE THE END OF A MONTH OR THE FILE 95% FULL
    !WE HERE CALL THE MANAGEMENT PACKAGE TO REPORT.

    integer(session file connect)=x'60'+(max proc slots*24)+(session total*28)
    integer(session file connect+8)=(integer(session file connect)>>12+1)<<12
    !ADJUST THE DATA FILE TO THE ACTUAL CURRENT LENGTH.

    disconnect("T#DIRSESS", flag)
    disconnect("JJ#DIRSESS", flag)
    newgen("T#DIRSESS","JJ#DIRSESS",flag)

    session monitor("AUTOMONTHLY") if  j=1

    ->next

  end ;  !OF CLOSE ANALYSES.


  routine  accounts analysis(integer  anal no, link)
    !THESE ARE THE CODE BODIES FOR THE ANALYSES OF THE SYSTEM ACCOUNTING
    !FILES THAT ARE STORED AS MAPPED DATA FILES IN THE JOURNAL SYSTEM.
  end ;  !OF ROUTINE ACCOUNTS ANALYSIS

  routine  common analysis(integer  anal no, link)
    !THIS ROUTINE CONTAINS THE CODE OF ANALYSES THAT ARE
    !COMMON TO ALL THE FILE TYPES ON THE JOURNAL SYSTEM

    switch  sw(1:2)
    ->sw(analno)

    sw(2):
      !THE SEARCH ON KEY ANALYSIS.
      print=match_print
      return 
  end ;  !OF COMMON ANALYSIS.


! ************************************************
  routine  mainlog analysis(integer  anal no, link)
    integer  store f0, store f1, store oldf1, flag
    integer  i, j, k, l, table ad, fail tcb
    string (8)array  lbe(0:2)
    string (32) stt1, stt2
    string (150) st
    string (16) seip
    switch  sw(1:10)
    switch  link 1(1:10)
    switch  link 2(1:10)
    switch  link 3(1:1)
    switch  link 4(1:1)
    switch  l4(1:5)
    conststring (8)array  discmess(1:12) = c 
        "C0 : ",
        "   S0 : ",
        "   T3 : ",
        "   T7 : ",
        "T11: ",
        "   T15: ",
        "   T19: ",
        "   T23: ",
        "T27: ",
        "   T31: ",
        "   M0 : ",
        "   M4 : "

    !THIS ROUTINE CONTAINS ALL THE CODE FOR THE VARIOUS MAINLOG ANALYSES.

!   %routine error count
!     !THIS ROUTINE FILLS IN THE ICL HEADER WITH THE CYCLIC ERROR
!     !COUNT FROM THE SECOND TWO BYTES OF ELB ERCOUNT.(WHICH IS THEN
!     !UPDATED.
!!     elb ercount=elb ercount+1
!     %if elb ercount>x'FFFF' %then elb ercount=0
!     elb head_seqn 1=byteinteger(addr(elb ercount)+2)
!     elb head_seqn 2=byteinteger(addr(elb ercount)+3)
!   %end;  !OF ROUTINE ERROR COUNT

!   %routine increment elb pointer(%integer inc)
!     !INCREMENT THE ADDRESS POINTER IN THE ICL ERROR FILE AND IF NECESSARY
!     !SEND A FULL FILE TO 'JOURNAL' AND START A NEW ONE.
!     elb addr=elb addr+inc
!     %if elb addr-elb base>=64*4096-128 %start
!       integer(elb base+x'14')=pack date and time(date, time)
!       integer(elb base+x'18')=x'FFFFFF04'
!       integer(elb base)=x'00040000'
!       disconnect("ICLERROR", flag)
!       send("ICLERROR,.JOURNAL")
!       connect("ICLERROR", 0, 0, 0, r, flag)
!       %if flag=0 %start
!         printstring(jtxt."Error-failed to send full icl file!")
!        newline
!         %stop
!       %finish
!       outfile("ICLERROR", 64*4096, 0, 0, conad, flag)
!       %if flag#0 %start
!         printstring(jtxt."Failed to create continuing icl file!")
!         newline
!         %stop
!       %finish
!       elb base=conad
!       elb addr=conad+x'20'
!       printstring(jtxt."New icl error file created.")
!       newline
!     %finish
!   %end

  integerfn  scan table(integer  ad)
     integer  i
     ! Scan input lines looking for a line containing the given address.
     ! Return first address in line if found, or 0.
     ! Assumes format O(...) 1 2 3 4 5 6 7 8 .  'O' optional: means that
     !   lines have been Omitted.
     cycle 
        resolve next line
        result  = 0 if  endflag=1 or  word count<9 or  stl(1)<10
        st<-makest(1)
        result  = 0 unless  st->("(").st.(")")
        hextobin(st,i)
        result =0 if  i>ad {caused by omitted lines}
        result  = i if  i<=ad<i+x'20'
     repeat 
  end ; ! Of %integerfn scan table.

  routine  continue
    !THIS ROUTINE IS USED WHEN OUTPUT IS DIRECTED TO THE CONSOLE TO
    !HOLD, CONTINUE OR TERMINATE AN ANLYSIS
    cycle 
      prompt("Continue:")
      read prompt reply(reply)
      if  charno(reply, 1)='Y' or  charno(reply, 1)='N' start 
         if  length(reply)=1 then  ss="" else  c 
            ss = substring(reply, 2, length(reply))
         exit 
      finish 
    repeat 
    if  charno(reply, 1)='Y' start 
       if  length(reply)=1 then  ss="" else  c 
         ss=substring(reply, 2, length(reply))
       return 
    finish 
    disconnect("JJ#TEMP", flag)
    destroy("JJ#TEMP", flag)
    if  tape up#"" then  unload mag(tape unit)
    printstring(jtxt."Analysis terminated as requested.")
    newline
    stop 
  end 

    ->sw(anal no)

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    sw(1):
    !THIS IS ASSOCIATED WITH THE AUTO ANALYSIS(ACCUMULATING)
    ->link 1(link)

      link 1(1):
      !-----------------------------------------------------------
      !A TAPE HAS BEEN MOUNTED, RECORD FOR THE TAPE LIBRARY
      !RECORDING SYSTEM.
      st<-makest(6)
      return  unless  charno(st,1)='M' and  (0<stl(8)<7)
      st -> ("M").ss
      for  i=1, 1, 20 cycle 
        exit  if  deck identity(i)_id=st
        if  deck identity(i)_id="" then  deck identity(i)_id<-st c 
          and  deck identity(i)_date<-log start and  exit 
        if  i=20 start 
          printstring(jtxt."Warning, >20 tape decks!!!")
          newline
          return 
        finish 
      repeat 
      if  deck identity(i)_date=0 then  deck identity(i)_date<-log start
      st<-makest(8)
      length(st) = 6 if  length(st)>6
      for  j=1, 1, tl max cycle 
        tape lib(j)_tsn = st if  tape lib(j)_tsn=""
        if  tape lib(j)_tsn=st start 
          tape lib(j)_deck(i)_mounts=tape lib(j)_deck(i)_mounts+1
          if  tape lib(j)_date=0 then  tape lib(j)_date<-log start
          tape lib(j)_last used = tl current run; ! Marks latest ref. to this tape.
          tl rec count = j if  tl rec count<j
          return 
        finish 
      repeat 
      !END OF TAPE LIB UPDATE.
      if  tl max flag=0 start 
         printstring(jtxt.">".intostr(tl max)." tapes in the library!!")
         newline
         tl max flag = 1
      finish 
      return 

      link 1(2):
      return 

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    sw(2):
    !THIS IS ASSOCIATED WITH RERUNABLE(ANYTIME) MAINLOG ANALYSES.
    ->link 2(link)

      link 2(1):
      !------------------------------------------------------
      !THIS IS CONCERNED WITH SINGLE BIT(SMAC) ERRORS.
      flag=0
      ddate<-makest(10)
      dtime<-makest(8)
      seip<-makest(13)
      store f0=fptr0;store f1=fptr1; store oldf1=oldfptr1
      resolve next line
      if  endflag#1 and  word count=6 and   c 
        comparest(1, "SMAC")=matched  start 
        cycle 
          resolve next line
          exit  if   stl(1)#1 or  word count<6 or  endflag=1
          st<-makest(4)
          hex to bin(st, i)
          if  i&smac fail mask(ocptype)#0 start 
            !WE HAVE FOUND AN ENTRY FOR A FAILED SMAC.
            if  sec=max unit errors start 
              sec date=ddate
              sec time=dtime
            finish 
            sec=sec+1
            return  if  sec>max unit errors
            smac record==smac error(sec)
            smac record_date<-ddate
            smac record_time<-dtime
!            %IF FULL RUN=ON %THEN %START;  !A FULL AUTOMATIC RUN INCLUDES ICL COMPAT. ERROR FILE
!              ELB HEAD==RECORD(ELB ADDR)
!              ELBT SMAC==RECORD(ELB ADDR+28)
!              HEX TO BIN(MAKEST(2), VAL)
!              ELBT SMAC_FDP=VAL
!              HEX TO BIN(MAKEST(3), VAL)
!              ELBT SMAC_FA=VAL
!              HEX TO BIN(MAKEST(4), VAL)
!              ELBT SMAC_STA=VAL
!              HEX TO BIN(MAKEST(6), VAL)
!              ELBT SMAC_CON=VAL
!              HEX TO BIN(SEIP, VAL)
!              ELBT SMAC_SEP=VAL
!              ELB HEAD_RTYP=X'01'
!              ELB HEAD_TTYP=X'22'
!              ELB HEAD_VALM=X'13FFFFFF';  !FOR ALL BUT 2980
!             !ELB HEAD_VALM=X'11FFFFFF';  !FOR 2980
!              ERROR COUNT
!              INCREMENT ELB POINTER(28)
!            %FINISH
            smac record_smac<-makest(1)
            smac record_pointer<-makest(2)
            smac record_address<-makest(3)
            smac record_eng state<-makest(5)
            smac record_status<-st
            smac record_config<-makest(6)
            smac record_sei param<-seip
            if  word count=7 then  smac record_data<-makest(7) c 
              else  smac record_data=""
          finish 
        repeat 
      finish 
      fptr0=store f0;fptr1=store f1; old fptr1 = store oldf1
      resolve line
      select output(0)
      return 

      link 2(2):
      !-------------------------------------------------------
      !THIS IS ASSOCIATED WITH RECORDING DISC ERRORS

      store f0=fptr0;store f1=fptr1; store oldf1=old fptr1
      ddate<-makest(9)
      dtime<-makest(10)
      if  dec=max unit errors start 
        dec date=ddate
        dec time=dtime
      finish 
      dec=dec+1
      return  if  dec>max unit errors
      de==disc error(dec)
      if  systype = P series start ; ! P Series code.
         de_date<-ddate
         de_time<-dtime
         de_media<-makest(4)
         de_dev<-makest(6)
         st <- makest(7)
         ->fail2 unless  st->("(").st.(")")
         de_route = substring(st,1,1)."/".substring(st,2,2)."/".substring(st,3,3)
         resolve next line
         if  endflag=1 or  word count#4 then  ->fail 2
         resolve next line
         if  endflag=1 or  word count#4 then  ->fail 2
         de_stream0<-makest(1)
         de_stream1<-makest(2)
         de_fcount<-makest(3)
         de_tcount<-makest(4)
         resolve next line
         ->fail2 if  endflag=1 or  comparest(1, "SENSE")=unmatched
         if  word count = 3 start 
          st <- makest(3)
           -> fail 2 unless  st-> ns1.("(RESP=").st.(")").ns2 and  c 
             ns1="" and  ns2=""
           de_ertype = "BDS" unless  substring(st,1,3)="008"
         finish 
         for  i=1, 1, 12 cycle 
           resolve next line
           ->fail2 if  endflag=1 or  word count#2
           if  i=1 start 
             ->fail2 if  comparest(1, "C0")=unmatched
             de_cstatus<-makest(2)
             continue 
           finish 
           if  i=2 start 
             ->fail2 if  comparest(1, "S0")=unmatched
             de_s0t2<-makest(2)
             continue 
           finish 
           if  i=3 start 
             ->fail2 if  comparest(1, "T3")=unmatched
             de_t3t6<-makest(2)
             continue 
           finish 
           if  i=11 start 
             ->fail2 if  comparest(1, "M0")=unmatched
             de_m0m3<-makest(2)
             continue 
           finish 
         repeat 
         resolve next line
         if  endflag=1 or  comparest(1, "RQB")=unmatched then  ->fail2
         seek=""
         cycle 
           stl(3)=0; stl(4)=0
           resolve next line
           ->fail2 if  endflag=1
           if  stl(word count)=10 then  seek<-makest(word count)
           stt1<-makest(1); stt2<-makest(2)
           exit  if  stt1->st.("*->") or  stt2->st.("*->")
           ->fail2 unless  stt2="->" or  comparest(3, "->")=matched
         repeat 
         de_fail lbe<-st
         if  seek="" start 
           !IE WE DON'T HAVE THE SEARCH KEY YET.
           cycle 
             resolve next line
             ->fail2 if  endflag=1
             exit  unless  comparest(2, "->")=matched or  c 
                 comparest(3, "->")=matched
             if  stl(word count)=10 then  seek<-makest(word count)
           repeat 
         finish 
         de_cyl inf<-seek
      finishelsestart ; ! S series code.
         de_date<-ddate
         de_time<-dtime
         de_media<-makest(4)
         de_dev<-makest(6)
         st<-makest(7)
         ->fail2 unless  st->("(").st.(")") and  length(st)>=4
         de_route = substring(st,1,2)."/".substring(st,3,4)
         resolve next line
         ->fail2 unless  word count=4
         de_tcb response <- makest(4)
         resolve next line; ! "Sense data ...".
         resolve next line
         ->fail2 if  endflag=1 or  wordcount#2 or  comparest(1,"S0T1T2T3")#matched
         de_s0t3 <- makest(2); resolve next line
         ->fail2 if  endflag=1 or  wordcount#2 or  comparest(1,"T4T5T6T7")#matched
         de_t4t7 <- makest(2); resolve next line
         ->fail2 if  endflag=1 or  wordcount#2 or  comparest(1,"T8T9TAC0")#matched
         st <- makest(2); length(st) = length(st)-2
         de_t8ta = st
         resolve next line
         resolve next line
         ->fail2 if  endflag=1 or  wordcount#2 or  comparest(1,"C5C6M0M1")#matched
         st <- makest(2)
         ->fail2 if  length(st)#8
         st = substring(st,5,8)
         de_m0m1 = st; resolve next line
         ->fail2 if  endflag=1 or  wordcount#2 or  comparest(1,"M2M3M4M5")#matched
         de_m2m5 <- makest(2); resolve next line
         ->fail2 if  endflag=1 or  wordcount#2 or  comparest(1,"M6M7M8M9")#matched
         de_m6m9 <- makest(2); resolve next line
         resolve next line
         ->fail2 if  comparest(1,"complete")=unmatched
         resolve next line
         j = 1
         st <- makest(1)
         j = j+1 while  st -> stt1.("->").st
         ! j now gives the number of chains.  Failing TCB is last one
         de_fail tcb = st
         resolve next line for  i=1,1,5
         ->fail2 if  word count#j or  comparest(j,de_tcb response)=unmatched
         resolve next line for  i=1,1,3
         ->fail2 if  word count#j or  stl(j)#8
         st <- makest(j)
         de_cylinf = substring(st,5,8)
         resolve next line
         ->fail2 if  word count#j or  stl(j)#8
         st <- makest(j)
         de_cylinf = de_cylinf.substring(st,1,6)
      finish 

      fptr0=store f0; fptr1=store f1; old fptr1=store oldf1
      resolve line
      return 
      fail2:
      fptr0=store f0; fptr1=store f1; old fptr1=store oldf1
      resolve line
      de_ertype="???"
      return 
      link 2(3):
      !------------------------------------------------------
      !THIS IS CONCERNED WITH DRUM ERROR REPORTING.
      !THE DATE AND TIME OF THE ERROR.
      st<-makest(4)
      unless  st="RECOVERY" or   st="FAILURE" then  return 
      store f0=fptr0;store f1=fptr1; store oldf1=old fptr1
      resolve next line
      if  endflag=1 or  word count #3 then  ->fail 3
      resolve next line
      if  word count#3 or  endflag=1 then  ->fail 3
      for  i=0, 1, 4 cycle 
        drum st(i)="********"
      repeat 
      ddate<-makest(6); dtime<-makest(7)
      if  drec=max unit errors start 
        drec date=ddate
        drec time=dtime
      finish 
      drec=drec+1
      return  if  drec>max unit errors
      drum record==drum error(drec)
      drum record_date<-ddate; drum record_time<-dtime
      drum record_route<-makest(1)."/".makest(2)."/".makest(3)
      if  st="RECOVERY" then  drum record_ertype="RCVD" c 
      else  start 
        drum record_ertype="UNRD"
        j=fptr1;  !IE WHERE TH SECTOR DESCRIPTION STARTS.
        for  i=1, 1, epage+1 cycle 
          resolve next line
          if  endflag=1 then  ->fail3
        repeat 
        if  word count#7 then  ->fail3
        !NOW POSITIONED AT THE START OF THE CONTROLLER STATUS WORDS.
        for  i=0, 1, 4 cycle 
          drum st(i)<-makest(i+3)
        repeat 
        !PRINTED THE STATUS WORDS.
        fptr1=j
        !IE REPOSITION AT START OF SECTOR DESCRIPTION.
      finish 
      for  i=0, 1, 4 cycle 
        drum record_stream(i)<-drum st(i)
      repeat 
      !NOW LOOK AT EACH DISC SECTOR REPORT.
      for  i=1, 1, epage cycle 
        resolve next line
        if  endflag=1 then  ->fail3
        ->fail3 unless  stl(1)=8 and  stl(2)=8
        drum record_drum sector(i)_word1<-makest(1)
        drum record_drum sector(i)_word2<-makest(2)
        st=""
        if  word count>=3 start 
          for  k=3, 1, word count cycle 
            st=st." ".makest(k)
          repeat 
        finish 
        if  length(st)>32 then  length(st)=32
        drum record_drum sector(i)_desc<-st
      repeat 
      fptr0=store f0;fptr1=store f1; old fptr1= store oldf1
      resolve line
      return 

      fail3:
      fptr0=store f0;fptr1=store f1; old fptr1=store oldf1
      resolve line
      drum record_ertype="??"
      return 

      link 2(4):
      link 2(5):
      !-------------------------------------------------------
      !THE FIRST OF TWO CODE SECTIONS FOR TAPE ERRORS.
      ns1 <- makest(1)
      return  unless  charno(ns1,1)='M'
      ns1 -> ("M").wstring
      j=-20
      for  i=-19, 1, 0 cycle 
        if  tape error(i)_dev=wstring then  j=i and  exit 
      repeat 
      if  j=-20 then  return 
      !IE NO ERRORS FOUND FOR THIS DECK.
      ddate=tape error(i)_date; dtime=tape error(i)_time
      if  tec=max unit errors start 
        tec date=ddate
        tec time=dtime
      finish 
      tec=tec+1
      return  if  tec>max unit errors
      tape record a==tape error(tec); tape record b==tape error(i)
      !WE MUST RECORD AN ERROR FOR THIS DECK.
      tape record a = tape record b
      tape record a_type = "UNRC" if  link=5
      tape record b_dev="";  !Close the error entry.
      return  if  tape record a_transfers="********"
      found = no
      for  j=1, 1, 20 cycle 
        deck record==deck errors(j)
        deck record_deck = tape record a_dev if  deck record_deck=""
        if  deck record_deck=tape record a_dev then  found = yes and  exit 
      repeat 
      if  found=no start 
        printstring(jtxt."More than 20 decks!!")
        newline
        return 
      finish 
      k=2
      if  tape record a_oper="READ" then  k=0
      if  tape record a_oper="WRITE" then  k=1
      deck errors(j)_ct(k, link-4)=deck errors(j)_ct(k, link-4)+1
      !UPDATE THE DECK ERROR COUNTS
      return 

      link 2(6):
      !--------------------------------------------------------
      !THE SECOND SECTION OF CODE DEALING WITH TAPE ERRORS
      store f0=fptr0;store f1=fptr1; store oldf1=old fptr1
      if  word count>=5 and  makest(5)="STIE/MTIE/RIPE" start 
        ! New (April 1982) single track error format.  See code following link2(7) below.
        new ste f = yes
        ->single track error
      finish 
      resolve next line
      if  endflag=1 or  word count#10 then  ->fail 5
      ->fail5 if  comparest(1, "DECK")=unmatched
      j=-20
      st<-makest(2)
      length(st) = 2 if  length(st)>2
      for  i=-19, 1, 0 cycle 
        tape error(i)_dev = st if  tape error(i)_dev=""
        if  tape error(i)_dev=st then  c 
          j=i and  exit 
      repeat 
      if  j=-20 start 
        select output(0)
        printstring(jtxt."Failure ... more than 20 decks??")
        newlines(3)
        stop 
      finish 
      tape record a==tape error(j)
      tape record a_type="RCVD"
      !IE WE HAVE NOW STARTED AN ENTRY FOR THIS RETRY IN THE
      !DECK INFORMATION TABLE.
      tape record a_failures<-makest(5)
      tape record a_oper<-makest(10)
      tape record a_date="********"
      tape record a_time="********"
      tape record a_stream0="********"
      tape record a_stream1="********"
      tape record a_t0t3="********"
      tape record a_t4t7="********"
      tape record a_t8t11="********"
      tape record a_transfers="********"
      tape record a_fail lbe="********"
      tape record a_media="******"
      tape record a_s0="**"
      if  stl(9)<7 then  tape record a_media<-makest(9)
      resolve next line
      if  endflag=1 or  word count#13 then  ->fail 5
      resolve next line
      if  endflag=1 or  word count#13 then  -> fail 5
      resolve next line
      if  endflag=1 then  -> fail 5
      unless  comparest(1, "DT:")=matched then  -> fail 5
      tape record a_date<-makest(2)
      tape record a_time<-makest(3)
      resolve next line
      if  endflag=1 or  comparest(5, "61")=unmatched then  ->fail 5
      if  stl(7)#8 then  -> fail 5
      st = makest(7)
      hextobin(st,table ad)
      if  sys type = P series start 
         resolve next line
         if  endflag=1 or  word count<9 then  -> fail 5
         lbe(0)<-makest(7); lbe(1)<-makest(8); lbe(2)<-makest(9)
         resolve next line
         if  endflag=1 or  word count<9 then  -> fail 5
         tape record a_stream0<-makest(5)
         tape record a_stream1<-makest(6)
         st<-makest(5)
         winteger = byteinteger(addr(st)+8)&x'0F'
         tape record a_fail lbe<-lbe(winteger) if  0<=winteger<=2
         j = scan table(table ad+x'98'); ! Address of t0t3.
         ->fail5 if  j=0
         tape record a_t0t3 <- makest(8)
         tape record a_t4t7 <- makest(9)
         resolve next line
         ->fail5 if  endflag=1 or  word count<9
         tape record a_t8t11 <- makest(2)
         tape record a_t12t15 <- makest(3)
         st <- makest(4)
         tape record a_s0 = substring(st,1,2)
         tape record a_transfers <- makest(6)
         ! Above posn of 'transfers' value moved in P Series mainlog during
         ! October 1982.
      finishelsestart ; ! S series.
         i = table ad+x'58'
         j = scan table(i); ! Note that scan table starts by looking at the NEXT line.
         -> fail 5 if  j=0
         ! Now on correct line of table.
         tape record a_t0t3 <- makest(8)
         tape record a_t4t7 <- makest(9)
         resolve next line
         ->fail5 if  endflag=1 or  wordcount<9
         tape record a_t8t11 <- makest(2)
         tape record a_t12t15 <- makest(3)
         st <- makest(4)
         tape record a_s0 = substring(st,1,2)
         tape record a_stream0 <- makest(6)
         tape record a_stream1 <- makest(7)
         fail tcb = charno(tape record a_stream0,8)-'0'
         -> fail 5 unless  0<=fail tcb<=5
         if  fail tcb=0 start 
            tape record a_fail lbe <- makest(8); ! Failing lbe is 1st word of failing tcb.
         finish  else  start 
            ! Must look for failing tcb.
            i = table ad+x'78'+56*fail tcb; ! table ad+x'78' is address of tcb(0).
            ! Now scan table looking for a line containing this address.
            j = scan table(i); ! j is first address on line, or 0 (failure).
            -> fail 5 if  j=0
            k = (i-j)>>2+2; ! Now gives no. of required atom.
            k = 2 if  k<2
            tape record a_fail lbe <- makest(k)
         finish 
          ! Now find no. of transfers value.
          i = table ad+x'78'+6*4*14{size of tcb array}+8
          ! Address of required word.
          j = scan table(i) if  i>=j+x'20'
          -> fail 5 if  j=0
          k = (i-j)>>2+2; ! Required atom.
          k = 2 if  k<2
          tape record a_transfers <- makest(k)
       finish 

    fail 5:
      fptr0=store f0;fptr1=store f1; old fptr1=store oldf1
      resolve line
      return 

      link 2(7):
      !--------------------------------------------------
      !SINGLE TRACK(TAPE) ERROR RECORDING.
      new ste f = no
  single track error:
      ! Label used when new (April 1982) single track error format detected.
      if  new ste f=yes start 
         resolve next line
         st <- makest(2); ! Should give tape deck, without the 'M'.
      finishelsestart ; ! Old format.
         st<-makest(1)
         unless  charno(st,1)='M' start 
           printstring(jtxt."Single track errors: faulty format for")
           printstring(" tape deck in mainlog: ".st)
           newline
           return 
         finishelse  st-> ("M").st
      finish 
      length(st) = 2 if  length(st)>2
      found = no
      for  i=1, 1, 20 cycle 
        deck errors(i)_deck = st if  deck errors(i)_deck=""
        if  deck errors(i)_deck=st then  found = yes and  exit 
      repeat 
      if  found=no start 
        printstring(jtxt."Single trk hr errors: too many decks!")
        newline
        return 
      finish 
      if  new ste f=yes then  st <- makest(9) else  st <- makest(2)
      length(st) = 6 if  length(st)>6
      stei == ste(i); ! Subscript i found above.
      found = no
      for  k=1, 1, 100 cycle 
        stei_tsns(k)_tsn = st if  stei_tsns(k)_tsn=""
        if  stei_tsns(k)_tsn=st then  found = yes and  exit 
      repeat 
      if  found=no start 
        printstring(jtxt."Single trk hr errors: tsn tables ")
        printstring("full for deck ".deck errors(i)_deck)
        newline
        return 
      finish 
      stei_tsns(k)_events=stei_tsns(k)_events+1
      if  new ste f=no start 
        st<-makest(12)
        hex to bin(st, j)
        if  (j>>16)&x'02'#0 then  stei_trk(8)=stei_trk(8)+1
        k=x'01'
        j=j>>8
        for  l=0, 1, 7 cycle 
          if  j&(k<<l)#0 then  stei_trk(l)=stei_trk(l)+1
        repeat 
        single trk hr errors=single trk hr errors+1
      finishelsestart ; ! New ste format.
        resolve next line; resolve next line
        hex to bin(makest(10),j)
        stei_trk(8) = stei_trk(8)+1 if  j&2#0
        hex to bin(makest(11),j)
        for  l=0,1,7 cycle 
           stei_trk(l) = stei_trk(l)+1 if  j&1#0
           j = j>>1
        repeat 
      finish 
      return 

      link 2(8):
      link 2(9):
      !----------------------------------------------------
      !OCP TYPE DEFINITION..
      st<-makest(5)
      ocptype = s to i(st)
      if  makest(4)="OCP" start 
         ! Contains systype also.
         st <- makest(6)
         if  st="P" then  systype = P series else  systype = S series
      finish 
      return 

      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!
      sw(3):
      !ASSOCIATED WITH  CONTROLLER DUMP TABLE EXTRACTION
      ->link 3(link)

      link 3(1):
      !--------------------------------
      !THE DUMP TABLE EXTRACTION TO FILE
      store f0=fptr0;store f1=fptr1; store oldf1=old fptr1
      st<-makest(4)
      if  st="GPC" then  gpc dumps=gpc dumps+1
      if  st="SFC" then  sfc dumps=sfc dumps+1
      if  st="DFC" then  dfc dumps=dfc dumps+1
      select output(controller stream)
      if  controller stream=0 then  newpage and  controller lines=3 c 
      else  newlines(2)
      printsymbol('-') for  i=1,1,70
      newlines(2)
      print log line
      newline
      cycle 
        resolve next line
        exit  if  endflag=1 or   c 
        (word count>9 and  comparest(1, "SPAD")=unmatched)
        if  wordcount=3 and  comparest(3, "ENDS")=matched start 
          printsymbol('-') for  i=1, 1, 70
          newline
          select output(0)
          fptr0=store f0;fptr1=store f1; old fptr1=store oldf1
          resolve line
          return 
        finish 
        print log line
        newline
        controller lines=controller lines+1
        if  controller lines=eng console lines start 
          controller lines=1
          continue if  controller stream=0
        finish 
      repeat 
      newlines(2)
      printstring("*** Table lost ***")
      newline
      printsymbol('-') for  i=1, 1, 70
      newline
      select output(0)
      fptr0=store f0;fptr1=store f1; old fptr1=store oldf1
      resolve line
      return 

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    sw(4):
    !ASSOCIATED WITH PRODUCING FULL ANALYSES OF DISC FAILURES FOR THE ENGINEERS
    ->link 4(link)

      link 4(1):
      !----------------------------------------
      !DISC DUMPING.
      store f0=fptr0;store f1=fptr1; store oldf1=old fptr1
      select output(disc dump stream)
      if  disc dump stream=0 then  newpage else  newlines(2)
      printsymbol('-') for  i=1, 1, 70
      newlines(2)
      printstring("Dump on ".makest(9)." AT ".makest(10))
      newlines(2)
      printstring("Disc transfer fails: ".makest(6)." route:".makest(7))
      printstring(" media:".makest(4)); newlines(2)
      resolve next line
      ->ddfail if  endflag=1 or  word count#4
      resolve next line
      ->ddfail if  endflag=1 or  word count#4
      printstring("Response 0: ".makest(1)."  response 1: ")
      printstring(makest(2)); newlines(2)
      printstring("Transfers:  "); spaces(8-stl(4))
      printstring(makest(4)."  failures:   ")
      spaces(8-stl(3)); printstring(makest(3))
      newlines(2)
      resolve next line
      ->ddfail if  endflag=1 or  comparest(1, "SENSE")= unmatched
      if  word count = 3 start 
        st <- makest(3)
        ->ddfail unless  length(st)>=6 and  substring(st, 1, 6)="(RESP="
        st -> ("RESP=").st
        ->ddfail unless  charno(st, length(st))=')'
        length(st) = length(st)-1
        printstring("Sense response word  ".st); newline
      finish 
      for  i=1, 1, 12 cycle 
        resolve next line
        ->ddfail if  endflag=1 or  word count#2
        printstring(disc mess(i).makest(2))
        newline if  i&12=i
      repeat 
      if  disc dump stream=0 then  continue
      printstring("  RCB      LBE       ADDRESS LIST      ID")
      newlines(2)
      resolve next line
      ->ddfail if  endflag=1 or  comparest(1, "RQB")=unmatched
      cycle 
        resolve next line
        ->ddfail if  endflag=1
        unless  comparest(2, "->")=matched or  comparest(3, "->")=matched  c 
          or   makest(1)->st.("*->") or  makest(2)->st.("*->") then  exit 
        unless  1<=word count<=5 then  ->ddfail
        ->l4(word count)

        l4(1):
        printstring("         ".st."*")
        ->l4n

        l4(2):
        if  comparest(2, "->")=matched start 
          printstring("         ".makest(2))
          ->l4n
        finish 
        st<-makest(1)
        if  st->st.("*->") start 
          printstring("         ".st."* ".makest(2))
          ->l4n
        finish 
        st<-makest(2)
        if  st->st.("*->") start 
          printstring(makest(1)." ".st."*")
          ->l4n
        finish 
        ->ddfail

        l4(3):
        if  comparest(3, "->")=matched start 
          printstring(makest(1)." ".makest(2))
          ->l4n
        finish 
        st<-makest(2)
        if  st->st.("*->") start 
          printstring(makest(1)." ".st."* ".makest(3))
          ->l4n
        finish 
        if  comparest(2, "->")=matched start 
          printstring("         ".makest(1)."  ".makest(3))
          ->l4n
        finish 
        st<-makest(1)
        if  st->st.("*->") start 
          printstring("         ".st."* ".makest(2)." ")
          printstring(makest(3))
          ->l4n
        finish 
        ->ddfail

        l4(4):
        if  comparest(3, "->")=matched start 
          printstring(makest(1)." ".makest(2)."  ".makest(4))
          ->l4n
        finish 
        st<-makest(2)
        if  st->st.("*->") start 
          printstring(makest(1)." ".st."* ".makest(3))
          printstring(" ".makest(4))
          ->l4n
        finish 
        if  comparest(2, "->")=matched start 
          printstring("         ".makest(1)."  ".makest(3)." ")
          printstring(makest(4))
          ->l4n
        finish 
        ->ddfail

        l4(5):
        if  comparest(3, "->")=matched start 
          printstring(makest(1)." ".makest(2)."  ".makest(4))
          printstring(" ".makest(5))
          ->l4n
        finish 
        ->ddfail

        l4n:
        newline
      repeat 
      newlines(2)
      printsymbol('-') for  i=1, 1, 70
      newline
      if  disc dump stream=0 then  continue
      fptr0=store f0;fptr1=store f1; old fptr1=store oldf1
      resolve line
      select output(0)
      return 
    ddfail:
      printstring("*** Record lost ***")
      newlines(2)
      printsymbol('-') for  i=1, 1, 70
      newline
      if  disc dump stream=0 then  continue
      fptr0=store f0;fptr1=store f1; old fptr1=store oldf1
      resolve line
      select output(0)
      return 

  end ;  !OF MAINLOG ANALYSIS.

!*********************************************************
  routine  volums analysis(integer  anal no, link)
  integer  i, j
  string (32) st
  switch  sw(1:1)
  switch  link 1(1:8)
  !THIS ROUTINE CONTAINS ALL THE CODE FOR THE VARIOUS VOLUMS ANALYSES.

  ->sw(anal no)

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  sw(1):
  !Associated with the automatic analysis of Volums logs.
  !Note: labels link1(5-8) are introduced to handle a new Volums log format,
  !      from Autumn 1982.  They are equivalent to link1(1-4), which are still
  !      retained and usable.
  ->link 1(link)

    link 1(1):
    !--------------------------------------------------
    !A RESTORE OF A FILE IS COMPLETED. (RESTORE ANALYSIS)
    identity<-makest(12).makest(14)
    !THIS IS THE IDENTITY BY WHICH THE RESTORE IS KNOWN AT THIS STAGE.
    restore end date=pack date and time(makest(2), makest(3))
    if  restore start date=0 then  restore start date=restore end date
    found = no
    for  i=1, 1, restore wk max cycle 
      found = yes and  exit  if  restore wk entry(i)_identity=identity
      !IE THE REQUEST FOR THIS FILE IS REMEMBERED.
    repeat 
    return  if  found=no
    rwke==restore wk entry(i)
    st<-makest(7)
    rwke_epages = s to i(st)
    rwke_dt arch=pack date and time(makest(16), makest(18))
    restore wk entry(i)_identity<-makest(6)
    !THIS IS THE NEW IDENTITY OF THE RESTORE.
    return 

    link 1(2):
    link 1(6):
    !--------------------------------------------------------
    !A RESTORE IS REQUESTED.  (RESTORE ANALYSIS)
    identity<-makest(7).makest(8)
    restore end date=pack date and time(makest(2), makest(3))
    if  restore start date=0 then  restore start date=restore end date
    cycle 
       for  i=1,1,restore wk max cycle 
         rwke == restore wk entry(i)
         continue  unless  rwke_identity = "" c 
          or  minutes between(rwke_dtreq, restore end date)>60*24*3
         ! In for 3 days - reuse slot.
         rwke_identity <- identity
         rwke_tsn <- makest(7)
         rwke_dtreq = restore end date
         rwke_dt tape loaded = 0
         return 
       repeat 

       printstring(jtxt."Restore analysis file JJ#VOLRWK about to be extended to hold up to")
       write(restore wk max+93, 3)
       printstring(" entries."); newline
       expand jfile("T#VOLRWK", 32+(restore wk max+93)*44, conad, flag)
       if  flag#0 start 
         printstring("Failed to extend file.")
         newline
         stop 
       finish 
       if  conad#0 start ; ! File reconnected.
         restore wk max == integer(conad+28)
         restore wk entry == array(conad+32, af restore wk entry)
       finish 
       restore wk max = restore wk max+93
    repeat 

    link 1(3):
    link 1(7):
    !-------------------------------------------------------------
    !THE "RESTORE OK" MESSAGE IS SENT TO THE USER, WE USE THIS MESSAGE
    !TO PICK UP THE FSYS.  (RESTORE ANALYSIS)
    identity<-makest(9)."."
    st<-makest(5)
    return  unless  charno(st,1)='"'; st -> ("""").st
    identity=identity.st
    restore end date=pack date and time(makest(2), makest(3))
    if  restore start date=0 then  restore start date=restore end date
    found = no
    for  i=1, 1, restore wk max cycle 
      found = yes and  exit  if  restore wk entry(i)_identity=identity
    repeat 
    return  if  found=no
    rwke==restore wk entry(i)
    restore entries=restore entries+1
    if  restore entries>restore head_max entries start 
      printstring("About to expand file JJ#VOLRTAB, by 1000 entries to")
      write(restore head_max entries+1000,4); newline
      expand jfile("JJ#VOLRTAB", 48+32*(restore head_max entries+1000),
        conad, flag)
      if  flag#0 start 
         printstring("Failed to increase file size")
         newline
         stop 
      finish 
      if  conad#0 start ; ! File was reconnected.
         restore head == record(conad)
         restore table == array(conad+size of(restore head), af restore table)
      finish 
      restore head_max entries = restore head_max entries+1000
    finish 

    rte==restore table(restore entries)
    !THE NEXT FREE ENTRY IN THE ACCUMULATION TABLE OF RESTORES.
    rte_tsn<-rwke_tsn
    identity->st.(".").identity
    rte_user<-st
    rte_epages<-rwke_epages
    rte_mins rest wait=minutes between(rwke_dt req, restore end date)
    rte_mins load wait = 0
    rte_mins load wait = minutes between(rwke_dtreq,rwke_dttape loaded) if  c 
      rwke_dt tape loaded#0
    rte_mins age=minutes between(rwke_dt arch, restore end date)
    st<-makest(12)
    j = s to i(st)
    rte_fsys <- j
    rwke_identity=""
    return 

    link 1(4):
    link 1(8):
    !--------------------------------------------------------
    ! "LOADED NO RING" line (restore request).
    loaded tape <- makest(5); ! Can be NOLABEL (i.e. 7 chars).
    restore end date=pack date and time(makest(2), makest(3))
    if  restore start date=0 then  restore start date=restore end date

    ! Now scan restore wk entry.
    for  j=1,1,restore wk max cycle 
      continue  unless  restore wk entry(j)_tsn=loaded tape
      restore wk entry(j)_dt tape loaded = restore end date
    repeat 
    return 

    link 1(5):
    !--------------------------------------------------
    !A RESTORE OF A FILE IS COMPLETED. (RESTORE ANALYSIS). Cf. link1(1):, above.
    identity<-makest(4).makest(5)
    length(identity) = length(identity)-1; ! Remove comma.
    !This is the identity by which the restore is known at this stage.
    restore end date=pack date and time(makest(2), makest(3))
    if  restore start date=0 then  restore start date=restore end date
    found = no
    for  i=1, 1, restore wk max cycle 
      found = yes and  exit  if  restore wk entry(i)_identity=identity
      !IE THE REQUEST FOR THIS FILE IS REMEMBERED.
    repeat 
    return  if  found=no
    rwke==restore wk entry(i)
    st<-makest(11)
    rwke_epages = s to i(st)
    rwke_dt arch=pack date and time(makest(9), makest(10))
    restore wk entry(i)_identity<-makest(15)
    !THIS IS THE NEW IDENTITY OF THE RESTORE.

  end ;  !OF ROUTINE VOLUMS ANALYSIS.

!  ***************************************************
  routine  spoolr analysis(integer  anal no, link)
  integer  i, j, l, slot
  longinteger  li
  string (128) st
  string (200) doc
  stringname  doc part
  switch  sw(1:2)
  switch  link 1(1:10)
  switch  link 2(1:5)
  string (6) buser
  string (32) stt1, stt2, stt3, remote, rdev
  !THIS ROUTINE CONTAINS ALL THE CODE FOR THE VARIOUS
  !SPOOLR ANALYSES.
  !
  if  journalsite = kent then  start 
     integerfn  hashname(stringname  user)
     integer  a,b,c,res
     !
     a = charno(user,1)
     b = charno(user,2)
     c = charno(user,6)
     res = a*b*c
     result  = res-(res//4096*4096)+1
     end ;   ! OF HASHNAME
     !
     !
     integerfn  find(stringname  user)
     integer  start,p
     !
     start = hashname(user)
     p = start
     !
     cycle 
        uce == ucr(p)
        if  uce_user = user then  result  = p
        if  uce_user = "" then  start 
           uce_user = user
           result  = p
        finish 
        p = p + 1
        if  p > 4096 then  p = 1
        if  p = start then  result  = 0
     repeat 
     end ;   ! OF FIND
  finish 
  !
  ->sw(anal no)

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  sw(1):
  !ASSOCIATED WITH THE AUTOMATIC ANALYSIS OF OUTPUT AND BATCH JOBS.
  ->link 1(link)

    link 1(1):
    !-----------------------------------------------------
    !THE QUEUEING OF A JOB FOR BATCH OR OUTPUT DEVICE.
    return  if  stl(4)>16 or  stl(5)#6
    stt1<-makest(6)
    return  unless  stt1->st.(".").stt1 and  length(st)=6
    return  if  substring(st,1,3)="EYR"
    ! Ignore ERTE jobs and output, and also "no-name" MAIL jobs.
    slot=0
    end date=pack date and time(makest(2), makest(3))
    if  start date=0 then  start date=end date
    if  journalsite = kent then  start 
       cend date = end date
       if  cstart date = 0 then  cstart date = cend date
    finish 
    stt3<-makest(4)
    return  if  stt3="JOURNAL"
    stt2<-makest(5)

    ! Place a new job (jobname is STT2)
    li = s to i(stt2)
    i = ((li<<1!1)¬¬2>>13)&127; ! Now 0<=i<=127.
    l = list head(i)
    if  l=0 start 
       slot = get cell(l)
       list head(i) = slot
    finish  else  if  cell(l)_jname>=stt2 start 
       ! Goes in at start of list.
       if  cell(l)_jname=stt2 start ; ! Already in list.
         return  if  minutes between(cell(l)_time q, end date)<2880
         ! I.e. if less than 2 days old retain and discard new one.
         slot = l; ! Otherwise overwrite old one with new one.
         cell(l)_size = 0; cell(l)_time unq = 0
       finishelsestart 
         slot = getcell(l)
         cell(slot)_next = l; cell(l)_last = slot
         list head(i) = slot
       finish 
    finishelsestart 
       cycle 
          j = cell(l)_next
          if  j=0 or  cell(j)_jname>=stt2 start 
             ! Goes in between l and j.
             if  j#0 and  cell(j)_jname=stt2 start ; ! Already in list.
               return  if  minutes between(cell(j)_time q, end date)<2880
               ! I.e. if less than 2 days old retain and discard new one.
               slot = j; ! Otherwise overwrite old one with new one.
               cell(l)_size = 0; cell(l)_time unq = 0
             finishelsestart 
               slot = getcell(listhead(i))
               cell(slot)_next = j; cell(j)_last = slot unless  j=0
               cell(l)_next = slot; cell(slot)_last = l
             finish 
             exit 
          finish 
          l = j
       repeat 
    finish 
    jws == cell(slot)
    jws_user<-st; jws_device<-stt3
    jws_jname<-stt2
    jws_time q<-end date
    return 

    link 1(2):
    !-------------------------------------------------------------
    !A JOB IS STARTED ON AN OUTPUT DEVICE.
    return  if  stl(4)>16 or  stl(5)#6
    stt1<-makest(5)
    ! Find job STT1 in file.
    li = s to i(stt1)
    i = ((li<<1!1)¬¬2>>13)&127
    l = list head(i)
    while  l#0 cycle 
       exit  if  cell(l)_jname>=stt1
       l = cell(l)_next
    repeat 
    cell(l)_time unq = pack date and time(makest(2), makest(3)) c 
     unless  l=0 or  cell(l)_jname>stt1
    return 

    link 1(3):
    !-----------------------------------------------------
    !A USER IS CHARGED FOR THE OUTPUT TO A DEVICE.
    return  if  stl(4)>16 or  stl(5)#6
    stt1<-makest(5)
    ! Find job STT1 in file.
    li = s to i(stt1)
    i = ((li<<1!1)¬¬2>>13)&127
    l = list head(i)
    while  l#0 cycle 
       exit  if  cell(l)_jname>=stt1
       l = cell(l)_next
    repeat 
    return  if  l=0 or  cell(l)_jname>stt1; ! Failed to find job (?)
    jws == cell(l)
    if  jws_time unq#0 start 
      !IE WE HAVE A COMPLETED ENTRY FOR THIS JOB
      st<-makest(11)
      return  unless  st->st.("K")
      jws_size = s to i (st)
      st<-makest(8)
      j = s to i(st)&255
      !IE THE FILE SYSTEM NUMBER

      extend cjob if  next job slot>max job slots
      je == job entry(next job slot)
      je_user<-jws_user
      je_device<-jws_device
      je_size<-jws_size
      je_mins qd = minutes between(jws_time q, jws_time unq)
      je_fsys = j
      je_mins ex= minutes between( c 
        jws_time unq, pack date and time(makest(2), makest(3)))
      next job slot=next job slot+1
    finish 

    if  journalsite = kent then  start 
       if  word count = 14 then  start ;   ! ACCOUNT FOR CONSUMABLES
          i = find(jws_user)
          if  i = 0 then  start 
             printstring("JOURNAL:  USER CONSUMABLES TABLE FULL, INFORM")
             printstring("          SYS MANAGER")
             newline
             return 
          finish 
          uce == ucr(i)
          st <- makest(14)
          j = s to i(st);   ! QUANTITY USED
          st <- makest(13);   ! TYPE OF CONSUMABLE
          if  st = "PAGES" then  start 
             uce_pages = uce_pages + j
          finish  else  start ;
          if  st = "CARDS" then  start 
             uce_cards = uce_cards + j
          finish  else  start ;
          if  st = "PPFEET" then  start 
             uce_ppfeet = uce_ppfeet + j
          finish  else  start ;
          if  st = "GPFEET" then  start 
             uce_gpfeet = uce_gpfeet + j
          finish 
          finish 
          finish 
          finish 
       finish 
    finish 
    remove cell(l)

    return 

    link 1(4):
    !------------------------------------------------------------
    !A BATCH JOB IS STARTED.
    return  if  stl(5)#6
    stt1<-makest(5)
    ! Find job STT1 in file.
    li = s to i(stt1)
    i = ((li<<1!1)¬¬2>>13)&127
    l = list head(i)
    while  l#0 cycle 
       exit  if  cell(l)_jname>=stt1
       l = cell(l)_next
    repeat 
    return  if  l=0 or  cell(l)_jname>stt1; ! Failed to find job (?)
    jws == cell(l)
    jws_time unq=pack date and time(makest(2), makest(3))
    jws_size <- s to i(makest(13))
    !IE THE REQUESTED CPU TIME.
    return 

    link 1(5):
    !-------------------------------------------------------
    !A BATCH JOB ENDS.
    return  if  stl(5)#6
    stt1<-makest(5)
    ! Find job STT1 in file.
    li = s to i(stt1)
    i = ((li<<1!1)¬¬2>>13)&127
    l = list head(i)
    while  l#0 cycle 
       exit  if  cell(l)_jname>=stt1
       l = cell(l)_next
    repeat 
    return  if  l=0 or  cell(l)_jname>stt1; ! Failed to find job (?)
    jws == cell(l)

    if  jws_time unq#0 and  comparest(13, "100")=matched start 
      extend cjob if  next job slot>max job slots

      je == job entry(next job slot)
      je_user<-jws_user
      je_device<-jws_device
      st<-makest(17)
      j = s to i(st)
      if  j>x'FFFFFE' then  j=x'FFFFFF'
      je_mins qd=j;  !PAGE TURNS.
      st<-makest(3)
      length(st)=2;  j = s to i(st)
      je_mins qd=(je_mins qd<<8)!j;  !ADD THE HOUR ENDING.
      je_size=minutes between(jws_time q, jws_time unq)
      je_size=(je_size<<16)!jws_size;  !THE REQ CPU SECONDS.
      !NOTE:
      !     SIZE== MINUTES QUEUED<<16 ! REQUESTED CPU SECS.
      !     MINS QD== PAGE TURNS<<8 ! HOUR JOB ENDED IN.
      !     MINS EXEC==  EXEC MINS<<16 ! ACTUAL CPU USED.
      st<-makest(8)
      j = s to i(st)
      je_fsys=byteinteger(addr(j)+3)
      st<-makest(15)
      j = s to i(st)
      je_mins ex=(minutes between c 
      (jws_timeunq, packdateandtime(makest(2), makest(3)))<<16)!j
      next job slot=next job slot+1
    finish 
    remove cell(l)
    return 

!                                                                         NETLOG
    link 1(6):
!   ----------------------------------------------------------------      NETLOG
!                                                                         NETLOG
!   Creation of NETLOG accounts record                                    NETLOG
!                                                                         NETLOG
    selectoutput(netlog stream);                                        ! NETLOG
    st="";                                                              ! NETLOG
    for  i=2,1,3 cycle ;                                                ! NETLOG
       st=st.makest(i)." ";                                             ! NETLOG
    repeat ;                                                            ! NETLOG
    stt1<-makest(5);                                                    ! NETLOG
    if  length(stt1)>8 then  length(stt1)=8;                            ! NETLOG
    stt1=stt1." " while  length(stt1)#8;                                ! NETLOG
    st=st.stt1." ".makest(6)." ";                                       ! NETLOG
    j=7;                                                                ! NETLOG
    stt1<-makest(j);                                                    ! NETLOG
    if  length(stt1)<=5 and  j#wordcount-3 start ;                      ! NETLOG
       stt2<-makest(j+1);                                               ! NETLOG
       if  length(stt2)=2 start ;                                       ! NETLOG
          stt1=stt1." " while  length(stt1)#6;                          ! NETLOG
          stt1=stt1.stt2;                                               ! NETLOG
          j=j+1;                                                        ! NETLOG
       finish ;                                                         ! NETLOG
    finish ;                                                            ! NETLOG
    stt1=stt1." " while  length(stt1)#8;                                ! NETLOG
    st=st.stt1." ";                                                     ! NETLOG
    j=j+1;                                                              ! NETLOG
    if  j=wordcount-2 start ;                                           ! NETLOG
       stt1="";                                                         ! NETLOG
       stt2="";                                                         ! NETLOG
    finishelsestart ;                                                   ! NETLOG
       stt1<-makest(j);                                                 ! NETLOG
       j=j+1;                                                           ! NETLOG
       if  j=wordcount-2 start ;                                        ! NETLOG
          if  length(stt1)<=6 then  stt2=stt1 else  stt2="";            ! NETLOG
       finishelse  stt2<-makest(j) and  j=j+1;                          ! NETLOG
    finish ;                                                            ! NETLOG
    stt1=stt1." " while  length(stt1)#8;                                ! NETLOG
    stt2=stt2." " while  length(stt2)#6;                                ! NETLOG
    st=st.stt1." ".stt2;                                                ! NETLOG
    for  i=j,1,wordcount cycle ;                                        ! NETLOG
       st=st." ".makest(i);                                             ! NETLOG
    repeat ;                                                            ! NETLOG
    printstring(st);                                                    ! NETLOG
    newline;                                                            ! NETLOG
    selectoutput(0);                                                    ! NETLOG
    return ;                                                            ! NETLOG
!                                                                         NETLOG
    link 1(7):
!   ------------------------------------------------------------------    NETLOG
!                                                                         NETLOG
!   Creation of NETLOG FTP record                                         NETLOG
!                                                                         NETLOG
    selectoutput(netlog stream);                                        ! NETLOG
    st="";                                                              ! NETLOG
    for  i=2,1,3 cycle ;                                                ! NETLOG
       st=st.makest(i)." ";                                             ! NETLOG
    repeat ;                                                            ! NETLOG
    stt1<-makest(11);                                                   ! NETLOG
    charno(stt1,1) = charno(stt1,1)&95
    stt1=stt1." " while  length(stt1)<4;                                ! NETLOG
    if  wordcount>12 then  stt2 = "PSS" else  stt2 = "   ";             ! NETLOG
    st=st.stt1." ".stt2." ".makest(6).": ".ocpdesc(ocptype,systype)."  FT "
    stt1<-makest(12);                                                   ! NETLOG
    if  length(stt1)>8 then  length(stt1)=8;                            ! NETLOG
    stt1=stt1." " while  length(stt1)#8;                                ! NETLOG
    stt2<-makest(8);                                                    ! NETLOG
    stt2=stt2." " while  length(stt2)<6;                                ! NETLOG
    st=st.stt1." ".stt2." ";                                            ! NETLOG
    stt1<-makest(10);                                                   ! NETLOG
    if  stt1->stt2.("k") then  i=s to i(stt2)<<3 else  i=0;             ! NETLOG
    st=st.intostr(i)." 0 0";                                            ! NETLOG
    printstring(st);                                                    ! NETLOG
    newline;                                                            ! NETLOG
    selectoutput(0);                                                    ! NETLOG
    return ;                                                            ! NETLOG
!                                                                         NETLOG

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  sw(2):
  !ASSOCIATED WITH PRODUCING A BY DEMAND REPORT ON THE BACKGROUND JOBS
  !RUN OVER THE SPECIFIED PERIOD FOR SPECIFIC OR ALL USERS.
    ->link 2(link)

    link 2(1):
    !---------------------------------------------------------
    !A JOB DOCUMENT, REPORT ON IT IF BATCH.
    remote=""; buser=""
    st<-makest(5)
    unless  st->remote.(".").rdev then  buser=st
    doc=""
    for  i=7, 1, word count cycle 
      doc=doc.makest(i)
    repeat 
    flag=0
    cycle 
      exit  unless  doc->stt1.("=").stt2.(",").doc
      if  stt1="USER" and  remote#"" then  buser=stt2
      if  stt1="DEST" start 
        return  unless  stt2="BATCH"
        flag=1
        exit  if  remote=""
      finish 
    repeat 
    if  flag=0 start 
      return  unless  doc="DEST=BATCH"
    finish 
    if  remote#"" and  length(st)>=5 and  substring(doc,1,5)="USER=" then  c 
      doc -> ("USER=").buser
    if  batch ucount>0 start 
      flag=0
      for  i=1, 1, batch ucount cycle 
        flag=1 and  exit  if  buser=batch user(i)
      repeat 
      return  unless  flag=1
    finish  else  start 
      return  if  buser="JOURNL"
    finish 
    select output(batch report stream)
    if  batch report lines>56 start 
      batch report lines=3
      newpage
      printstring("Emas 2900 Journal System report on background jobs ")
      printstring("For user(s): ")
      if  batch ucount=-1 then  printstring("ALL") else  start 
        for  i=1, 1, batch ucount cycle 
         printstring(batch user(i)."  ")
         if  i=8 or  i=16 then  newline and  spaces(64)
        repeat 
      finish 
      newline
      printsymbol('-') for  i=1, 1, 132
      newline
    finish  else  start 
      if  st#last batch user then  newline and  c 
        batch report lines=batch report lines+1
    finish 
    last batch user=buser
    printstring(makest(2)." ".makest(3)." ".buser." ")
    if  remote="" start 
      printstring("From:  user process")
      spaces(8)
    finish  else  start 
      printstring("From:  ")
      st=remote." ".rdev
      printstring(st); spaces(20-length(st))
    finish 
    doc=""
    for  i=7, 1, word count cycle 
      doc=doc.makest(i)
    repeat 
    if  length(doc)>77 start 
      j=length(doc)
      length(doc)=77
      printstring(doc); newline; spaces(53)
      byteinteger(addr(doc)+77)=j-77
      doc part==string(addr(doc)+77)
      printstring(doc part)
    finish  else  printstring(doc)
    newline
    batch report lines=batch report lines+1
    return 

    link 2(2):
    !----------------------------------------
    !A BATCH JOB IS QUEUED
    st<-makest(6); st->stt1.(".").stt2
    select output(batch report stream)
    if  batch ucount>0 start 
      flag=0
      for  i=1, 1, batch ucount cycle 
        flag=1 and  exit  if  stt1=batch user(i)
      repeat 
      return  unless  flag=1
    finish  else  start 
      return  if  stt1="JOURNL"
    finish 
    select output(batch report stream)
    if  batch report lines>56 start 
      batch report lines=3
      newpage
      printstring("EMAS 2900 Journal System report on background jobs ")
      printstring("For user(s): ")
      if  batch ucount=-1 then  printstring("ALL") else  start 
        for  i=1, 1, batch ucount cycle 
         printstring(batch user(i)."  ")
         if  i&7=0 then  newline and  spaces(63)
        repeat 
      finish 
      newline
      printsymbol('-') for  i=1, 1, 132
      newline
    finish  else  start 
      if  stt1#last batch user then  newline and  c 
        batch report lines=batch report lines+1
    finish 
    last batch user=stt1
    printstring(makest(2)." ".makest(3)." ".stt1." ".makest(5)." ".stt2)
    spaces(20-length(stt2))
    printstring("Queued   ")
    newline; batch report lines=batch report lines+1
    return 

    link 2(3):
    !-------------------------------------------------
    !A BATCH JOB IS UNQUEUED.
    select output(batch report stream)
    st<-makest(6); st->stt1.(".").stt2
    if  batch ucount>0 start 
      flag=0
      for  i=1, 1, batch ucount cycle 
        flag=1 and  exit  if  stt1=batch user(i)
      repeat 
      return  unless  flag=1
    finish  else  start 
      return  if  stt1="JOURNL"
    finish 
    select output(batch report stream)
    if  batch report lines>56 start 
      batch report lines=3
      newpage
      printstring("EMAS 2900 Journal System report on background jobs ")
      printstring("For user(s): ")
      if  batch ucount=-1 then  printstring("ALL") else  start 
        for  i=1, 1, batch ucount cycle 
         printstring(batch user(i)."  ")
         if  i&7=0 then  newline and  spaces(63)
        repeat 
      finish 
      newline
      printsymbol('-') for  i=1, 1, 132
      newline
    finish  else  start 
      if  last batch user#stt1 then  newline and  c 
        batch report lines=batch report lines+1
    finish 
    last batch user=stt1
    printstring(makest(2)." ".makest(3)." ".stt1." ".makest(5)." ".stt2)
    spaces(20-length(stt2))
    printstring("Unqueued ")
    newline
    batch report lines=batch report lines+1
    return 

    link 2(4):
    !----------------------------------------------------
    !A BATCH JOB STARTS.
    select output(batch report stream)
    st<-makest(6)
    st->stt1.(".").stt2
    if  batch ucount>0 start 
      flag=0
      for  i=1, 1, batch ucount cycle 
        flag=1 and  exit  if  stt1=batch user(i)
      repeat 
      return  unless  flag=1
    finish  else  start 
      return  if  stt1="JOURNL"
    finish 
    select output(batch report stream)
    if  batch report lines>56 start 
      batch report lines=3
      newpage
      printstring("EMAS 2900 Journal System report on background jobs ")
      printstring("for user(s): ")
      if  batch ucount=-1 then  printstring("ALL") else  start 
        for  i=1, 1, batch ucount cycle 
         printstring(batch user(i)."  ")
         if  i=8 or  i=16 then  newline and  spaces(63)
        repeat 
      finish 
      newline
      printsymbol('-') for  i=1, 1, 132
      newline
    finish  else  start 
      if  stt1#last batch user then  newline and  c 
        batch report lines=batch report lines+1
    finish 
    last batch user=stt1
    printstring(makest(2)." ".makest(3)." ".stt1." ".makest(5)." ".stt2)
    spaces(20-length(stt2))
    printstring("Started  as ".makest(11))
    printstring(", requested cpu: ".makest(13)." seconds")
    newline; batch report lines=batch report lines+1
    return 

    link 2(5):
    !--------------------------------------------------
    !A BATCH JOB ENDS.
    select output(batch report stream)
    st<-makest(6); st->stt1.(".").stt2
    if  batch ucount>0 start 
      flag=0
      for  i=1, 1, batch ucount cycle 
        flag=1 and  exit  if  stt1=batch user(i)
      repeat 
      return  unless  flag=1
    finish  else  start 
      return  if  stt1="JOURNL"
    finish 
    select output(batch report stream)
    if  batch report lines>56 start 
      batch report lines=3
      newpage
      printstring("EMAS 2900 Journal System report on background jobs ")
      printstring("for user(s): ")
      if  batch ucount=-1 then  printstring("ALL") else  start 
        for  i=1, 1, batch ucount cycle 
         printstring(batch user(i)."  ")
         if  i=8 or  i=16 then  newline and  spaces(63)
        repeat 
      finish 
      newline
      printsymbol('-') for  i=1, 1, 132
      newline
    finish  else  start 
      if  last batch user#stt1 then  newline and  c 
        batch report lines=batch report lines+1
    finish 
    last batch user=stt1
    printstring(makest(2)." ".makest(3)." ".stt1." ".makest(5)." ".stt2)
    spaces(20-length(stt2))
    printstring("Finished as ".makest(11))
    printstring(", actual cpu: ".makest(15)." seconds, ")
    printstring(" pageturns: ".makest(17).", reason: ".makest(13))
    newline; batch report lines=batch report lines+1
    return 

  end ;  !OF SPOOLR ANALYSIS.

! **********************************************
  routine  direct analysis(integer  anal no, link)
  owninteger  slfmess=0; ! "Session list full" message flag.
  switch  sw(1:1)
  switch  link 1(1:3)
  string (128) st
  integer  i

  ->sw(anal no)

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  sw(1):
  !THE AUTOMATIC DIRECT LOG ANALYSIS.
  -> link 1(link)

    link 1(1):
    !----------------------------------------------
    !THE START OF A FOREGROUND SESSION.
    st<-makest(11)
    i = s to i(st)
    return  unless  3<i<=max proc slots
    return  unless  stl(7)=6;  !IE USER NAME OF 6 CHARS.
    if  session list start=0 then  session list start= c 
      pack date and time(makest(2), makest(3))
    session list end=pack date and time(makest(2), makest(3))
    proc secondary(i) = proc primary(i) if  proc primary(i)_user#""
    proc primary(i)_user<-makest(7)
    proc primary(i)_start<-session list end
    if  link=1 then  proc primary(i)_type=foreground else  c 
      proc primary(i)_type<-background
    return 

    link 1(2):
    !----------------------------------------------
    !A BACKGROUND SESSION STARTS.
    -> link 1(1)

    link 1(3):
    !---------------------------------------------------
    !A SESSION ENDS.
    st<-makest(11)
    i = s to i(st)
    return  unless  3<i<=max proc slots
    return  unless  stl(7)=6 and  comparest(13, "100")=matched
    session list end=pack date and time(makest(2), makest(3))
    session list start = session list end if  session list start=0
    st<-makest(7)
    return  if  proc primary(i)_user#st and  proc secondary(i)_user#st
    session total = session total+1
    if  session total>max monthly sessions start 
      return  if  slfmess=1
      printstring(jtxt."Session list full!!.")
      newline
      slfmess = 1
      return 
    finish 
    sl == sessions list(session total)
    if  proc primary(i)_user#st start 
      sl_user<-proc secondary(i)_user
      sl_type<-proc secondary(i)_type
      sl_end<-session list end
      sl_elapse=minutes between( c 
        proc secondary(i)_start, session list end)
    finish  else  start 
      sl_user<-proc primary(i)_user
      sl_type<-proc primary(i)_type
      sl_end<-session list end
      sl_elapse=minutes between(proc primary(i)_start, session list end)
      proc primary(i)_user=""
    finish 
    proc secondary(i)_user = ""
    sl_cpu = s to i(makest(15))
    sl_pageturns = s to i(makest(17))
    sl_procs = s to i(makest(19))

  end ;  !OF ROUTINE DIRECT ANALYSIS

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

  routine  retrieve file(integer  seq, dt from, dt to, integername  flag)
    !This routine looks for the specified file and brings
    !it back from its specified storage medium (tape or pd file)
    !and puts it into the temporary file tempfile.
    !File date range must overlap with [dt from, dt to].
    !Returns flag of 0 if successful else a flag of 1.
    string (6) tape
     integer  i, len, wkaddr, epages, status, chapter

    routine  fails(string (32) s)
      printstring(jtxt.s."  File: ".tempfile)
      newline
      printstring("          retrieve fails, run ends.!")
      newline; stop 
    end ;  !Of routine fails

    flag = 0
    if  seq=-1 start 
      !This only happens when the analysis called is the special engineering
      !analysis of the current mainlog which is not yet indexed within the
      !Journal system.  We do not check the date range in this case.
      tempfile="JENGSP"
      return 
    finish 
    wkaddr=addr(buffer(0))
    tempfile="J".intostr(id char)."I".intostr(index entry(seq)_file id)
    status=index entry(seq)_status
    if  (index entry(seq)_starting<dtfrom and  index entry(seq)_finishing<dtfrom) c 
      or  (index entry(seq)_starting>dtto and  index entry(seq)_finishing>dtto)  c 
      start 
       printstring(jtxt."Date range of file ".tempfile." outwith required range.")
       newline
       flag = 1
       return 
    finish 

    if  status=9 start 
      printstring(jtxt."'".tempfile."' has been deleted.")
      newline
      flag=1
      return 
    finish 
    if  analysis="AUTOMATIC" start 
      printstring("Analysing file: ".intostr(index entry(seq)_file id))
      newline
    finish 
    flag = 1 and  return  if  status>2
    if  status<2 start 
      !The file is on line in pd file.
      if  tape up#"" start 
        !MAY AS WELL UNLOAD TAPE HERE.
        unload mag(tape unit)
        tape up=""
      finish 
      tempfile=pdstore."_".tempfile
    finishelsestart ; ! status=2.
      !The file must be retrieved from tape.
      tape=index entry(seq)_tape
      chapter=index entry(seq)_chapter
      if  tape up#tape start 
        if  tape up#"" then  unload mag(tape unit)
        select output(0)
        printstring(jtxt."Mag tape ".tape." required.")
        newline
        open mag(tape unit, tape)
        !OPEN THE REQUIRED TAPE.
        printstring(jtxt."The tape has been mounted.")
        newline
        fskip tm mag(tape unit, 1, flag);  !GET BEYOND THE LABEL.
        if  flag#0 start 
          printstring(jtxt."Unexpected double tape mark??")
          newline
          stop 
        finish 
        current chapter=1
        tape up=tape
      finish 
      if  chapter>current chapter start 
       fskip tm mag(tape unit, chapter-current chapter, flag)
        if  flag#0 start 
          printstring(jtxt."Unexpected double tape mark??")
          newline
          stop 
        finish 
      finish  else  start 
        if  chapter#1 start 
          fskip tm mag(tape unit, chapter-current chapter-1, flag)
          if  flag#0 start 
            printstring(jtxt."Unexpected double tape mark??")
            newline
            stop 
          finish 

          fskip tm mag(tape unit, 1, flag)
          if  flag#0 then   start 
            printstring(jtxt."Unexpected double tape mark??")
            newline
            stop 
          finish 
        finish 
      finish 
      !NOW POSITIONED AT THE START OF THE REQUIRED CHAPTER
      current chapter=chapter
      len=block
      read mag(tape unit, wkaddr, len, flag)
      if  flag>0 then  fails("HEADER READ FAIL: ".intostr(flag))
      chapter header==record(wkaddr)
      if  chapter header_file name#tempfile then  c 
        fails("WRONG FILE, CHPTR:".intostr(chapter)." ACTUAL ". c 
        intostr(chapter header_chapter))
      epages=chapter header_epages
      outfile("JJ#TEMP", epages*block, 0, 0, conad, flag)
      if  flag#0 start 
        printstring(jtxt."Cannot create 'JJ#TEMP' :".intostr(flag))
        newline; stop 
      finish 
      for  i=1, 1, epages cycle 
        len=block
        read mag(tape unit, wkaddr, len, flag)
        if  flag>0 then  fails("FILE READ FAILS: ".intostr(flag))
        move(block, wkaddr, conad)
        conad=conad+block
      repeat 
      tempfile="JJ#TEMP"
    finish 
  end ;  !OF ROUTINE RETRIEVE FILE.

  routine  new members(string  (31) pdfile,
                       integer  members,
                       string  array  name  in file name,
                       integer  array  name  member flags,
                       integer  name  flag)

    ! This routine takes the files whose names are supplied in
    ! IN FILE NAME (1:MEMBERS) and copies them as members into
    ! the PD file whose name is supplied as PDFILE.  The name
    ! of each file will be used as the name of the corresponding
    ! member.  They will overwrite any existing members of the
    ! same names.  The files to be copied may belong to other
    ! users, and may be members of PD files (but not of PD files
    ! which are themselves members of other PD files).  The PD
    ! file into which the members will be copied must belong to
    ! the caller, and may not itself be a member of a PD file.
    ! Errors which prevent the routine from working at all will
    ! be reported by setting non-zero values in FLAG.  FLAG=0 on
    ! exit indicates that the routine has finished successfully.
    ! Any flag concerning an individual file or member is returned
    ! in the element of MEMBER FLAGS corresponding to the relevant
    ! IN FILE NAME.  In these flags, zero does not necessarily mean
    ! success, nor does non-zero always indicate failure.  Note that
    ! the strings in IN FILE NAME will all be translated into
    ! upper case as a side effect of this routine.

    ! The values of FLAG which can be returned are -
    !   258 : attempt to overwrite another user's PD file
    !   286 : nominated file is not a PD file
    !   287 : attempt to copy two files which would have the same
    !         member name when inserted into the PD file
    !   various values returned by CONNECT if it fails to connect
    !         the PD file
    !   various values returned by OUTFILE if it fails to create
    !         a work file
    !   various values returned by NEWGEN if it fails to replace the
    !         original PD file with the modified PD file which has
    !         been constructed in the work file.

    ! Values which can be returned in MEMBER FLAGS are -
    !   270 : name does not yield an acceptable member name
    !   287 : another IN FILE NAME yields the same member name
    !   288 : no member of this name existed in the PD file before
    !         the call of NEW MEMBERS
    !   various flags returned by CONNECT if it fails to connect the
    !         file to be copied.

    ! 0 and 288 indicate success.  270 and the CONNECT flags
    ! mean that the member has not been inserted (and any member
    ! of the same name which was originally in the PD file
    ! will be unaltered).  287 means that the PD file has not
    ! been altered at all.  No values will be assigned to MEMBER FLAGS
    ! if FLAG has the value 258, 286, or any value returned by failing
    ! to CONNECT the PD file.  You must therefore take care to avoid
    ! getting 'unassigned variable' faults when analysing the flags.

    string  (255) owner
    record  (rf)pdr
    record  (pdhf)name  pdh
    integer  base, adir, new size, new mems, i, j, k, l, in file length
    string  name  in file
    integer  name  in flag
       uctranslate (addr(pdfile)+1, length(pdfile))
       if      pdfile->owner.(".").pdfile c 
          and  owner#uinfs(1)             c 
       then  flag = 258                   c 
       else  connect (pdfile, 0, 0, 0, pdr, flag)
       if  flag=0 start 
          if  pdr_filetype#sspdfiletype then  flag = 286 else  start 
             if  members>0 start 
                begin 

                   integerfn  checkmembername (string  name  s)
                   ! Checks the string S to see that it is non-null, not more
                   ! than 11 characters, starts with a letter, and contains
                   ! only letters and digits.  Returns zero if O.K., 270
                   ! otherwise.

                   ! The table BITMAP declared below is for use with *TCH: it
                   ! has 256 bits numbered from 0 to 255, which are zero for
                   ! the ISO values for letters and digits, and ones for all
                   ! other values.
                   const  integer  array  bitmap (0:7) = c 
                      x'FFFFFFFF',
                      x'FFFF003F',
                      x'8000001F',
                      x'FFFFFFFF',
                      x'FFFFFFFF',
                      x'FFFFFFFF',
                      x'FFFFFFFF',
                      x'FFFFFFFF'
                   long  integer  bmd, strd
                   integer  i, l
                      l = length (s)
                      i = addr (s) + 1
                      result  = 270 unless  0<l<=11 c 
                         and  'A'<=byte integer(i)<='Z'
                      bmd = x'0000010000000000' ! ADDR(BITMAP(0))
                      strd = (lengtheni(x'18000000'!l)<<32) ! i
                      *lsd_bmd
                      *ld_strd
                      *tch_l =dr 
                      *jcc_8, <ok>
                      result  = 270
                   ok:
                      result  = 0;                      !O.K.
                   end ;                                !OF CHECKMEMBERNAME

                   string  (255) mn, dummy
                   integer  member length, newbase, new entry ad, new data ptr
                   integer  move it, member start, new space, changes, dirlim
                   record  (pdhf)name  new pdh
                   record  (pdf)name  new entry
                   record  (pdf)name  pd
                   record  format  member details c 
                         (string  (11) name, integer  filead, filesize)
                   record  (member details)array  member table (1:members)
                   record  (member details)name  details
                   record  (rf)fr
                   base = pdr_conad
                   pdh == record (base)
                   adir = pdh_adir + base
                   new size = pdh_dataend
                   new mems = pdh_count
                   for  i=members, -1, 1 cycle 
                      in file == in file name (i)
                      uctranslate (addr(in file)+1, length(in file))
                      mn = in file unless  in file -> owner.(".").mn
                      if  mn->dummy.("_").mn start ; finish 
                      member table (i)_name <- mn
                      k = check member name (mn)
                      member flags (i) = k
                      if  k=0 start 
                         j = members
                         while  j>i cycle 
                            if  mn=member table(j)_name start 
                               member flags (i) = 287
                               member flags (j) = 287
                               flag = 287
                            finish 
                            j = j - 1
                         repeat 
                      finish 
                   repeat 
                   changes = members
                   if  flag=0 start 
                      for  i=members, -1, 1 cycle 
                         in file == in file name (i)
                         in flag == member flags (i)
                         details == member table (i)
                         if  in flag=0 then  connect (in file, 0, 0, 0, fr, in flag)
                         if  in flag#0 then  changes = changes - 1 else  start 
                            in file length = (fr_dataend+7)&(-8)
                            if  in file length<16 then  in file length = 16
                            details_filead = fr_conad
                            details_filesize = in file length
                            mn = details_name
                            j = adir
                            dirlim = adir + 32*pdh_count
                            while  j<dirlim cycle 
                               pd == record (j)
                               if  pd_name = mn then  exit 
                               j = j + 32
                            repeat 
                            if  j>=dirlim start 
                               in flag = 288; ! This will be a new member.
                               new mems = new mems + 1
                               member length = -32
                            finish  else  start 
                               member length = (integer(base+pd_start)+7)&(-8)
                               if  member length<16 then  member length = 16
                            finish 
                            new size = new size - member length + in file length
                         finish 
                      repeat 
                      new space = (new size+4095)&(-4096)
                      outfile ("T#PDUTWK", new space, new space, 0, newbase, flag)
                   finish 
                   if  changes>0=flag start 
                      new pdh == record (newbase)
                      new pdh_filetype = sspdfiletype
                      new pdh_dataend = newsize
                      new pdh_count = new mems
                      new pdh_adir = newsize - 32 * new mems
                      new entry ad = newbase + new pdh_adir
                      new data ptr = new pdh_datastart + newbase
                      j = adir
                      while  j<dirlim cycle 
                         pd == record (j)
                         move it = -1
                         for  l=members, -1, 1 cycle 
                            if    pd_name=member table(l)_name c 
                            and   member flags (l)=0           c 
                            start 
                               move it = 0
                               exit 
                            finish 
                         repeat 
                         if  move it#0 start 
                            member start = pd_start + base
                            member length = (integer(member start)+7)&(-8)
                            if  member length<16 then  member length = 16
                            move (member length, member start, new data ptr)
                            new entry == record (new entry ad)
                            new entry_name <- pd_name
                            new entry_start = new data ptr - newbase
                            new data ptr = new data ptr + member length
                            new entry ad = new entry ad + 32
                         finish 
                         j = j + 32
                      repeat 
                      for  k=members, -1, 1 cycle 
                         unless  0#member flags(k)#288 start 
                            details == member table (k)
                            move (details_filesize, details_filead, new data ptr)
                            new entry == record (new entry ad)
                            new entry_name <- details_name
                            new entry_start = new data ptr - newbase
                            new data ptr = new data ptr + details_filesize
                            new entry ad = new entry ad + 32
                         finish 
                      repeat 
                      newgen ("T#PDUTWK", pdfile, flag)
                   finish 
                end 
             finish 
          finish 
       finish 
    end ; ! new members.

  stringfn  makest(integer  word)
    !THIS ROUTINE FORMS THE WORD SPECIFIED BY THE LENGTH AND ADDRESS
    !ENTRIES FOR WORD : WORD.
    string (132) st
    byteintegername  l
    byteinteger  ch
    integer  m, max, maddr

    max = stl(word); maddr = st addr(word)
    m = 0
    l == byteinteger(addr(st)); l=0
    while  m<max cycle 
      ch = byteinteger(maddr+m)
      l = l+1 and  charno(st,l) = ch unless  ch<32
      m = m+1
    repeat 
    result =st
  end ;  !OF STRINGFN MAKEST.

  integerfn  comparest(integer  word, string (32) st)
    !THIS ROUTINE COMPARES THE STRING ST WITH THE WORD
    !DEFINE BY THE ENTRIES FOR WORD: WORD.
    integer  l, saddr, msaddr
    l=length(st)
    result =0 unless  l=stl(word)
    saddr=addr(st)+1; msaddr=st addr(word)
    *ldtb_sptr0
    *ldb_l;       !LENGTH
    *lda_saddr
    *cyd_0
    *lda_msaddr;    !THE ADDRESSES.
    *put_x'A500';  !COMPARE
    *jcc_8, <match>;  !MATCH ->
    result =0
match:
    result =1
  end ;  !OF INTEGERFN COMPAREST.

  routine  get next line
    word count=0
    resolved = no
    cycle 
      old fptr1=fptr1
      *ldtb_fptr0
      *lda_fptr1
      *lb_10
      *put_x'A300'
      *jcc_8, <eof>
      *modd_1
      *std_fptr0
      return  if  fptr1-oldfptr1>1
    repeat 
eof:
    endflag = 1
  end ; ! Of get next line.

  routine  resolve line
    integer  l, ws, length, lw
    resolved = yes
    return  if  endflag=1
    length=sptr0!(fptr1-oldfptr1-1)
    lw=oldfptr1
    cycle 
      ws=lw
      *ldtb_length
      *lda_lw
      *lb_32
      *put_x'A300'
      *jcc_8, <eol>
      *modd_1
      *std_length
      l=lw-ws
      if  l>1 start 
        word count=(word count+1)&x'7F'
        stl(word count)=(l-1)&x'7F'
        st addr(word count)=ws
      finish 
    repeat 
eol:
    l=fptr1-ws
    if  l>1 start 
      word count=(word count+1)&x'7F'
      stl(word count)=(l-1)&x'7F'
      st addr(word count)=ws
    finish 
  end ;  !OF ROUTINE RESOLVE LINE

  routine  resolve next line
     get next line and  resolve line until  word count#0 or  endflag=1
  end ; ! Of %routine get next line.

  integerfn  search(stringname  s)
     ! Search for first occurrence of s in range given by fptr0 and fptr1:
     ! fptr1 gives address of start of next-to-current line.
     ! fptr0 = x'58000000' ! length to be searched (i.e. to end-of-file).

     byteintegerarray  skip(0:20)
     byteintegerarrayname  spat
     byteintegerarrayformat  spatf(0:20)
     integer  ls, sls, a, size, fend, dr0, dr1, p, q, j

     spat == array(addr(s), spatf)
     ! Set up skip array (used in searching code, below).
     ls = spat(0); ! Length of string s.
     for  j = 1,1,ls cycle 
        skip(j) = j-alph(spat(j))
        alph(spat(j)) = j
     repeat 
     ! Now reset to zero the changed elements of alph.
     alph(spat(j)) = 0 for  j = 1,1,ls

     ! Now search for string.  Look for last letter of string first.
     sls = spat(ls)
     fend = fptr1 + fptr0&(¬sptr0) - 1; ! sptr0 = X'58000000'.
     a = fptr1+ls-1; ! Start address of search.
     while  a<=fend cycle 
        size = fend-a+1
        *ldtb_sptr0
        *ldb_size
        *lda_a
        *lb_sls
        *swne_l =dr 
        *jcc_8,<nomatch>
        *std_dr0
        p = dr1; q = p
        j = ls-1
        while  j>0 cycle 
           q = q-1
           if  byteinteger(q)#spat(j) start ; ! Match failure.
              a = p+skip(j+1)
              exit 
           finish 
           j = j-1
        repeat 
        result  = q if  j=0; ! Success.
     repeat 
nomatch:
     result  = 0
  end ; ! Of %integerfn search.

  routine  print log line
     ! Prints current log line on current output.
     integer  j
     return  if  oldfptr1>=fptr1
     print symbol(byteinteger(j)) for  j=oldfptr1,1,fptr1-1
  end ; ! Of %routine print log line.

  routine  reduce ijob
      integer  i, l, pdt, p
      record (cell f)name  c

      if  freen=0 and  freep#0 start 
         printstring("**REDUCE IJOB  Warning: freen = 0, freep =")
         write(freep,2); newline
      finish 
      pdt = pack date and time(date, time)
      for  l = 0,1,127 cycle 
         p = listhead(l)
         while  p#0 cycle 
            c == cell(p)
            i = c_next
            remove cell(p) if  c_time q=0 or  minutes between(c_time q, pdt)>7200
            ! Delete job - in list for over 5 days (Spoolr log lost?)
            p = i
         repeat ; ! This list tidied.
      repeat ; ! All lists now tidied.
   
      while  freen>300 cycle 
         ! We can reduce file by 3 epages = 256 48-byte cells.
         for  i=maxcells,-1,maxcells-255 cycle 
            return  unless  cell(i)_user="<FREE>"
         repeat 
   
         freen = freen-256
         maxcells = maxcells-256
         ijob head_size = ijob head_size-256*48
         ijob head_end = ijob head_size
         i = maxcells
         i = i-1 while  cell(i)_user#"<FREE>"
         ! i now gives end of freelist.
         cell(i)_next = 0
      repeat 
  end ; ! Of %routine reduce ijob.

  routine  expand ijob
     integer  i, j, cells, conad, flag
  
     if  freen=0 and  freep#0 start 
         printstring("**EXPAND IJOB:  Warning: freen = 0,  freep =")
         write(freep,2); newline
     finish 
  
     return  if  freen>10
     ! Insufficient - must increase filesize (by 3 epages = 256 cells)
     cells = ijob head_maxcells+256
     expand jfile("T#SPIJOB", 304+48*cells, conad, flag)
     if  flag#0 start 
         printstring("Failed to increase file T#SPIJOB to hold up to")
         write(cells,3); printstring(" entries.")
         newline
         stop 
     finish 
     if  conad#0 start ; ! File was reconnected.
         ijob head == record(conad)
         maxcells == ijob head_maxcells
         listhead == ijob head_listhead
         freen == ijob head_freen
         freep == ijob head_freep
         cell == array(conad+size of(ijob head), caf)
     finish 

     ! Find end of freelist
     if  freep=0 start 
         freep = maxcells+1; i = 0
     finishelsestart 
         i = maxcells
         i = i-1 while  cell(i)_user#"<FREE>"
         cell(i)_next = maxcells+1
     finish 

     for  j=maxcells+1,1,maxcells+256 cycle 
        cell(j)_next = j+1; cell(j)_last = j-1
        cell(j)_user = "<FREE>"
     repeat 
     cell(maxcells+1)_last = i; ! i is last cell in old freelist, or 0 if empty.
     cell(maxcells+256)_next = 0
     maxcells = maxcells+256
     freen = freen+256
     ijob head_size = size of(ijob head)+48*cells
     ijob head_end = ijob head_size
  end ; ! of %routine expand ijob.

  integerfn  getcell(integer  close to)
     integer  i
     expand ijob if  freen=0
     if  freep>close to start 
        i = freep
        freep = cell(freep)_next
        cell(freep)_last = 0 unless  freep=0
     finishelsestart 
         ! Find free cell < close to.
         close to = close to-1 until  cell(close to)_user="<FREE>"
         i = close to
         if  cell(i)_last=0 start 
            freep = cell(i)_next
         finishelse  cell(cell(i)_last)_next = cell(i)_next
         cell(cell(i)_next)_last = cell(i)_last unless  cell(i)_next=0
     finish 
     freen = freen-1
     cell(i) = 0
     result  = i
  end ; ! Of %integerfn getcell.
  
  routine  remove cell(integer  i)
     integer  j
     long  integer  li
     ! First take cell out of list
     if  cell(i)_user="<FREE>" start 
         printstring("**REMOVE CELL: cell to be removed is already in the freelist??")
         write(i,3); newline
         stop 
     finish 
     if  cell(i)_last=0 start 
        ! Cell was at start of a list.  Find listhead by using hashing fn.
        li = s to i(cell(i)_jname)
        j = ((li<<1!1)¬¬2>>13)&127
        if  i#listhead(j) start 
           printstring("Faulty list structure (in 'remove cell'):
li =")
           write(li,6); newline
           printstring("j, listhead(j), i (should be at start of jth list) =")
           write(j,2); write(listhead(j),2); write(i,2); newline
           stop 
        finish 
        listhead(j) = cell(i)_next
     finishelse  cell(cell(i)_last)_next = cell(i)_next
     cell(cell(i)_next)_last = cell(i)_last unless  cell(i)_next=0
     cell(i) = 0; ! Note - removed cell set to zeroes.
  
     ! Now add to freelist, in correct ordinal position.
      if  i<freep or  freep=0 start 
         cell(i)_next = freep
         cell(freep)_last = i unless  freep=0
         freep = i
      finishelsestart 
         j = i-1
         j = j-1 while  cell(j)_user#"<FREE>"
         cell(i)_next = cell(j)_next
         cell(i)_last = j
         cell(cell(j)_next)_last = i unless  cell(j)_next=0
         cell(j)_next = i
      finish 
     cell(i)_user = "<FREE>"
     freen = freen+1
  end ; ! Of %routine remove cell.

  routine  extend cjob
      integer  conad, flag, slots
      slots = cjob head_max job slots+512
      expand jfile("JJ#SPCJOB", slots*40+size of(cjob head), conad, flag)
      ! 5 new epages.
      if  flag#0 start 
         printstring("Failed to extend file JJ#SPCJOB by 512 entries to")
         write(slots,3); newline
         stop 
      finish 
      if  conad#0 start ; ! File reconnected.
         cjob head == record(conad)
         max job slots == cjob head_max job slots
         next job slot = cjob head_next job slot
         start date = cjob head_start date
         end date = cjob head_end date
         job entry == array(conad+size of(cjob head), af job entry)
      finish 
      cjob head_size = size of(cjob head)+40*slots
      cjob head_end = cjob head_size
      max job slots = max job slots+512
  end ; ! Of %routine extend cjob.


end ;  !OF ROUTINE JOURNAL ANALYSIS

!**************************************************************************
!          ROUTINES AND FUNCTIONS COMMON TO THE SYSTEM.
!**************************************************************************

  routine  identify index(stringname  keyword, byteintegername   c 
          id char, data type, integername  entry)
  !HERE WE ARE GIVEN AN INDEX IDENTITY KEYWORD IE 'ERRORLOG' AND
  !WE SEARCH TO SEE IF IT IS VALID, IF IT IS WE PASS BACK THE
  !IDENTITY OF THE INDEX IN THE RANGE '0' TO '99' WHICH DEFINES THE
  !INDEX E.G. JJ'8'DEX ELSE WE PASS BACK A DEFAULT FAIL VALUE OF -1.
  record (f index list)arrayformat  af index list(0:total indices)
  record (f index list)arrayname  index list
  record  (rf)r
  string (16) file
  integer  i, flag
  file="JJMASTER"
  connect(file, 0, 0, 0, r, flag)
  if  flag#0 then  master file failure(file, flag)
  index list==array(r_conad+x'30', af index list)
  for  i=0, 1, total indices cycle 
    if  index list(i)_identity=keyword start 
      id char=index list(i)_id char
      data type=index list(i)_data type
      entry=i
      return 
    finish 
  repeat 
  id char=100;  !IE FAILED TO FIND MATCHING KEYWORD.
  end ;  !OF IDENTIFY INDEX.

routine  master file failure(stringname  file, integer  flag)
  !HERE WE PRINT THE WARNING OF A FAILURE(MISSING) MASTER FILE
  !AND STOP THE SYSTEM.
  select output(0)
  printstring(jtxt.file." lost, major fault.  flag: ")
  write(flag, 2)
  newlines(2)
  stop 
  end ;  !OF JJMASTER FAILURE.

endoffile