!***********************************************************************
!*
!*           Routines for interrogating an EMAS configuration
!*
!*         Copyright R.D. Eager   University of Kent   MCMLXXIX
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!*          Record and array formats
!*
!***********************************************************************
!
recordformat  comf(integer  ocptype,ipldev,sblks,sepgs,ndiscs,
         dlvnaddr,gpctabsize,gpca,sfctabsize,sfca,sfck,dirsite,
         dcodeda,suplvn,tojday,date0,date1,date2,
         time0,time1,time2,epagesize,users,cattad,servaad,
         byteinteger  nsacs,resv1,sacport1,sacport0,
         nocps,resv2,ocpport1,ocpport0,
         integer  itint,contypea,gpcconfa,fpcconfa,sfcconfa,
         blkaddr,ration,smacs,trans,longinteger  kmon,
         integer  ditaddr,smacpos,supvsn,pstva,secsfrmn,secstocd,
         sync1dest,sync2dest,asyncdest,maxprocs,inspersec,elaphead,
         commsreca,storeaad,procaad,sfcctad,drumtad,tslice,feps,
         maxcbt,performad,sp1,sp2,sp3,sp4,sp5,sp6,
         lstl,lstb,pstl,pstb,hkeys,hoot,sim,clkx,clky,clkz,
         hbit,slaveoff,inhssr,sdr1,sdr2,sdr3,
         sdr4,sesr,hoffbit,blockzbit,blkshift,blksize,end)
                                        ! As at CHOPSUPE 21C
recordformat  escbf(integer  hq,lq,saw0,pawbs,addstrs)
recordformat  ddtform(integer  ser,pts,propaddr,stick,caa,rqa,
         lba,ala,state,iw1,concount,sense1,sense2,sense3,
         sense4,repsno,base,id,dlvn,mnemonic,
         string (6) lab,byteinteger  mech,
         integer  props,stats1,stats2,
         byteinteger  qstate,prio,sp1,sp2,
         integer  lqlink,uqlink,curcyl,sema,trlink,chfisa)
recordformat  dirinff(string (6) user,string (31) batchfile,
                      integer  mark,fsys,procno,isuff,reason,batchid,
                      sessiclim,scidensad,scidens,operno,aiostat,
                      scdate,sync1dest,sync2dest,asyncdest,aactrec,
                      aicrevs,string (15) batchiden)
recordformat  dtentf(integer  nsecs,conti,sptrk,next,state,
                     integername  mark,paw,piw,
                     record (escbf)array  escbs(0:31))
recordformat  gpctf(byteinteger  flags,devtype,spareb,link,
                    integer  props0,props1,dev ent base,sparei,ptsm,
                    mnemonic,byteinteger  mechindex,props03,servrt,
                    state)
recordformat  fdf(integer  link,dsnum,byteinteger  status,accessroute,
                  valid action,cur state,mode of use,mode,file org,
                  dev code,rec type,flags,lm,rm,integer  asvar,arec,
                  recsize,minrec,maxrec,maxsize,lastrec,conad,currec,
                  cur,end,transfers,darecnum,cursize,datastart,
                  string (31) iden,integer  keydesc0,keydesc1,
                  recsizedesc0,recsizedesc1,byteinteger  f77flag,
                  f77form,f77access,f77status,integer  f77recl,f77nrec,
                  idaddr,byteinteger  f77blank,f77ufd,spare1,spare2)
!
ownintegerarrayformat  gpcf(0:10000)
ownbyteintegerarrayformat  contype(0:31)
!
!
!***********************************************************************
!*
!*          Constants
!*
!***********************************************************************
!
constantinteger  no = 0, yes = 1
constantinteger  slotsi = 32
constantinteger  dmnem = m'ZX';         ! Dummy device
constantstring (1) snl = "
"
constantrecord (comf)name  com = x'80c00000'
!
!
!***********************************************************************
!*
!*          Subsystem and Director references
!*
!***********************************************************************
!
externalstringfunctionspec  date
systemroutinespec  define(integer  chan,string (31) iden,
                          integername  afd,flag)
systemstringfunctionspec  htos(integer  value,places)
systemstringfunctionspec  itos(integer  n)
systemroutinespec  oper(integer  operno,string (255) s)
externalstringfunctionspec  time
externalintegerfunctionspec  uinfi(integer  n)
externalstringfunctionspec  uinfs(integer  n)
!
!
!***********************************************************************
!*
!*          Own variables
!*
!***********************************************************************
!
owninteger  reason = -1
owninteger  operno
owninteger  charcount
ownstring (50) opbuff
!
!
!***********************************************************************
!*
!*          Service routines
!*
!***********************************************************************
!
routine  initialise
record (dirinff)name  dirinf
!
return  if  reason >= 0;       ! Already initialised
!
dirinf == record(uinfi(10));   ! Director information record
reason = dirinf_reason;        ! Says whether started from OPER
charcount = 0
operno = dirinf_operno
opbuff = ""
end ;   ! of initialise
!
!-----------------------------------------------------------------------
!
routine  print(string (255) s)
integer  i,l,ch
!
if  reason # 1 then  printstring(s) and  return 
                                        ! Not on OPER
!
l = length(s)
return  if  l = 0
!
for  i = 1,1,l cycle 
   ch = charno(s,i)
   opbuff = opbuff.tostring(ch)
   charcount = charcount + 1
   if  ch = nl then  start 
      if  charcount > 23 then  length(opbuff) = length(opbuff) - 1
      oper(operno,opbuff)
      charcount = 0
      opbuff = ""
   finish 
repeat 
end ;   ! of print
!
!-----------------------------------------------------------------------
!
string (4)function  mtos(integer  m)
integer  i,j,a
string (4) s
!
a = addr(m)
j = 0
for  i = 0,1,3 cycle 
   unless  byteinteger(a+i) = 0 then  start 
      j = j + 1
      charno(s,j) = byteinteger(a+i)
   finish 
repeat 
length(s) = j
result  = s
end ;   ! of mtos
!
!
!***********************************************************************
!*
!*          D I S C S
!*
!***********************************************************************
!
externalroutine  discs(string (255) parms)
record (ddtform)name  ddtent
switch  ddtstate(0:15)
string (255) s
string (4) type
string (8) lab
integer  i,ndiscs,ditptr,all,cyls
!
initialise
if  parms = ".ALL" then  all = yes else  all = no
ndiscs = com_ndiscs;                    ! Number of disc drives
ditptr = com_ditaddr;                   ! Address of DIT
!
for  i = 1,1,ndiscs cycle 
   lab = ""
   ddtent == record(integer(ditptr))
   ditptr = ditptr + 4
   continue  if  ddtent_mnemonic >> 16 = dmnem
   !
   -> ddtstate(ddtent_state)
   !
   ddtstate(0):
   ddtstate(1):
   ddtstate(2):
   ddtstate(3):
   ddtstate(15):  s = "unloaded"
                  -> out
   !
   ddtstate(4):
   ddtstate(5):
   ddtstate(6):
   ddtstate(9):
   ddtstate(10):  s = "loaded "
                  -> label
   !
   ddtstate(7):
   ddtstate(8):   s = "awt rld"
                  -> out
   !
   ddtstate(11):
   ddtstate(12):
   ddtstate(13):
   ddtstate(14):  s = "priv   "
                  -> label
   !
label:
   if  ddtent_lab = "nolabl" then  start 
      lab = "no label"
      type = ""
   else 
      lab = ddtent_lab
      if  ddtent_base = 0 then  type = "frgn" else  type = "EMAS"
   finish 
   s = s.lab." ".type
   if  all = yes and  ddtent_base = x'800' then  s = s." (IPL volume)"
   !
out:
   print(mtos(ddtent_mnemonic)." ")
   if  all = yes then  start 
      cyls = integer(ddtent_propaddr+4)
      if  cyls = 404 then  print("[EDS100] ")
      if  cyls = 808 then  print("[EDS200] ")
      print("on ".htos(ddtent_pts,3)." ")
   finish 
   print(s.snl)
repeat 
end ;   ! of discs
!
!
!***********************************************************************
!*
!*          S T O R E
!*
!***********************************************************************
!
externalroutine  store(string (255) parms)
integer  all,i,smacs,usmacs
!
initialise
if  parms = ".ALL" then  all = yes else  all = no
!
if  all = yes then  start 
   print("SMAC numbers present:".snl)
   smacs = com_smacs & x'ffff'
   usmacs = com_smacs >> 16
   for  i = 0,1,15 cycle 
      if  (smacs >> (15-i)) & 1 # 0 then  start 
         print("   ".itos(15-i))
         if  (usmacs >> (15-i)) & 1 # 0 then  print("  (in perm use)")
         print(snl)
      finish 
   repeat 
finish 
!
print("Main store = ".itos(com_sblks << 7)." Kb".snl)
end ;   ! of store
!
!
!***********************************************************************
!*
!*          P O R T S
!*
!***********************************************************************
!
externalroutine  ports(string (255) parms)
integer  i
!
initialise
if  com_nsacs = 1 then  start 
   print("SAC on port ".itos(com_sacport0).snl)
finish  else  start 
   i = com_ipldev>>8&15
   print("SAC on port ".itos(i)."   (IPL)".snl)
   print("SAC on port ".itos(i!!1).snl)
finish 
if  com_nocps = 1 then  start 
   print("OCP on port ".itos(com_ocpport0).snl)
finish  else  start 
   print("OCP on port ".itos(com_ocpport0)."   (IPL)".snl)
   print("OCP on port ".itos(com_ocpport1).snl)
finish 
end ;   ! of ports
!
!
!***********************************************************************
!*
!*          T R U N K S
!*
!***********************************************************************
!
externalroutine  trunks(string (255) parms)
byteintegerarrayname  contable
switch  type(1:3)
string (4) mnem
integer  code,i,j,all,firstsacport,lastsacport,sacport,nsacs
!
initialise
if  parms = ".ALL" then  all = yes else  all = no
contable == array(com_contypea,contype)
nsacs = com_nsacs
if  nsacs = 1 then  start 
   firstsacport = com_sacport0
   lastsacport = com_sacport0
else 
   firstsacport = 0
   lastsacport = 1
finish 
!
for  sacport = firstsacport,1,lastsacport cycle 
   print("SAC on port ".itos(sacport).":".snl)
   for  j = 0,1,15 cycle 
      i = sacport*16+j
      code = contable(i)
      if  1 <= code <= 3 then  start 
         if  all = yes then  start 
            print("   Trunk ".itos(j)." reports ")
         else 
            print("   ".itos(j)." - ")
         finish 
         -> type(code)
         !
         type(1):  mnem = "SFC1"
                   -> out
         type(2):  mnem = "FPC2"
                   -> out
         type(3):  mnem = "GPC1"
                   -> out
         !
      out:
         print(mnem.snl)
      finish 
   repeat 
repeat 
end ;   ! of trunks
!
!
!***********************************************************************
!*
!*          G P C S
!*
!***********************************************************************
!
externalroutine  gpcs(string (255) parms)
record (gpctf)name  g
integerarrayname  gpct
integer  i,gpca,pt,slotno,lastslot,gpct base,strm,ngpcs
!
initialise
gpca = com_gpca
gpct == array(gpca,gpcf)
gpct base = addr(gpct(gpct(1)))
lastslot = gpct(2)
ngpcs = gpct(3)
!
for  i = 1,1,ngpcs cycle 
   pt = gpct(15+i) & x'ff'
   print("GPC on port ".itos(pt>>4).", trunk ".itos(pt&x'f').":".snl)
   for  slotno = 0,1,lastslot cycle 
      g == record(gpct base + slotno*slotsi)
      if  g_mnemonic >> 8 = dmnem then  continue 
      if  (g_ptsm >> 8) & x'ff' = pt then  start 
                                        ! On this GPC
         strm = (g_ptsm >> 4) & x'f'
         print("   ".mtos(g_mnemonic)." on stream ".itos(strm).snl)
      finish 
   repeat 
repeat 
end ;   ! of gpcs
!
!
!***********************************************************************
!*
!*          F E P S
!*
!***********************************************************************
!
externalroutine  feps(string (255) parms)
integer  i,foundmap,avmap,all
!
initialise
if  parms = ".ALL" then  all = yes else  all = no
!
if  com_feps = 0 then  start 
   print("No front end processors".snl)
   return 
finish 
!
foundmap = com_feps >> 16
avmap = com_feps & x'ffff'
!
if  all = yes then  print("Front end processors:".snl)
!
for  i = 0,1,9 cycle 
   continue  if  (foundmap >> i) & 1 = 0
   print("   FE".itos(i).":   ")
!  %if (avmap >> i) & 1 = 0 %then print("not ")
                                        ! Un-comment when Director actually sets this
   print("available".snl)
repeat 
end ;   ! of feps
!
!
!***********************************************************************
!*
!*          D R U M S
!*
!***********************************************************************
!
externalroutine  drums(string (255) parms)
integer  sfca,sfctabsize,i
record (dtentf)name  dtent
string (255) s
!
initialise
sfctabsize = com_sfctabsize
!
if  sfctabsize = 0 then  start 
   print("No drums in system".snl)
   return 
finish 
!
sfca = com_sfca
dtent == record(sfca+4)
!
print("Drums:".snl)
i = 0
cycle 
   s = "Drum ".itos(i).": ".itos(dtent_nsecs)
   i = i + 1
   while  length(s) < 6 cycle 
      s = s." "
   repeat 
   s = s." sectors - "
   if  dtent_state < 0 then  s = s."in"
   print(s."operable".snl)
   exit  if  dtent_next = 0
   dtent == record(dtent_next)
repeat 
end ;   ! of drums
!
!
!***********************************************************************
!*
!*          C O N F I G
!*
!***********************************************************************
!
externalroutine  config(string (255) parms)
integer  dirvsn,ipldev
string (7) v
!
initialise
if  reason = 1 then  v = "vsn" else  v = "version"
!
print("Supervisor ".v." = ".string(addr(com_supvsn)).snl)
print("OCP type is ".uinfs(10).snl)
ipldev = com_ipldev & x'fff'
print("IPL from ")
print(htos(ipldev&x'fff',3).snl)
print("SLOAD from ".itos(com_suplvn).snl)
dirvsn = (((com_dcodeda) & x'ffffff') - x'200')//x'40'
print("DIRVSN = ".itos(dirvsn).snl)
end ;   ! of config
!
!
!***********************************************************************
!*
!*          S T A T U S
!*
!***********************************************************************
!
externalroutine  status(string (255) parms)
integer  afd,flag
!
initialise
!
if  parms # "" then  start 
   define(1,parms,afd,flag)
   selectoutput(1)
   reason = 0;                          ! Force non-OPER format
finish 
!
print("Machine status on ".date." at ".time.snl)
print(snl)
config("")
store(".ALL")
print(snl)
discs(".ALL")
print(snl)
drums("")
print(snl)
ports("")
print(snl)
trunks(".ALL")
print(snl)
gpcs(".ALL")
print(snl)
feps(".ALL")
end ;   ! of status
endoffile