!***********************************************************************
!*
!*         Routines for interrogating an EMAS configuration
!*
!*       Copyright R.D. Eager   University of Kent   MCMLXXIX
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!*          Constants
!*
!***********************************************************************
!
CONSTINTEGER  COM RECORD = X'80C00000'
CONSTINTEGER  SLOTSI = 32
CONSTINTEGER  DMNEM = M'ZX';            ! Dummy device
CONSTSTRING (1) SNL = "
"
!
!
!***********************************************************************
!*
!*          Record and array formats
!*
!***********************************************************************
!
RECORDFORMAT  COMF(INTEGER  OCPTYPE,IPLDEV,SBLKS,SEPGS,NDISCS,  C 
         DDTADDR,GPCTABSIZE,GPCA,SFCTABSIZE,SFCA,SFCK,DIRSITE,  C 
         DCODEDA,SUPLVN,WASKLOKCORRECT,DATE0,DATE1,DATE2,  C 
         TIME0,TIME1,TIME2,EPAGESIZE,USERS,CATTAD,DQADDR,  C 
         BYTEINTEGER  NSACS,RESV1,SACPORT1,SACPORT0, C 
         NOCPS,RESV2,OCPPORT1,OCPPORT0, C 
         INTEGER  ITINT,CONTYPEA,GPCCONFA,FPCCONFA,SFCCONFA, C 
         BLKADDR,DPTADDR,SMACS,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,SP1, C 
         SP2,SP3,SP4,SP5,SP6,SP7,SP8, C 
         LSTL,LSTB,PSTL,PSTB,HKEYS,HOOT,SIM,CLKX,CLKY,CLKZ,  C 
         HBIT,SLAVEOFF,INHSSR,SDR1,SDR2,SDR3,  C 
         SDR4,SESR,HOFFBIT,S2,S3,S4,END);   ! As at CHOPSUPE 20K
RECORDFORMAT  ESCBF(INTEGER  HQ,LQ,SAW0,PAWBS,ADDSTRS)
RECORDFORMAT  DDTFORM(INTEGER  SER,PTS,PROPADDR,STICK,STATS, C 
      RQA,LBA,ALA,STATE,IW1,IW2,SENSE1,SENSE2,SENSE3, C 
      SENSE4,REPSNO,BASE,ID,DLVN,MNEMONIC, C 
      STRING (6) LAB,BYTEINTEGER  MECH)
RECORDFORMAT  DIRINFF(STRING (6) USER,STRING (31) BATCHFILE,C 
                      INTEGER  MARK,FSYS,PROCNO,ISUFF,REASON,BATCHID,C 
                      SESSICLIM,SCIDENSAD,SCIDENS,OPERNO,AIOSTAT,C 
                      SCDATE,SYNC1DEST,SYNC2DEST,ASYNCDEST,AACTREC,C 
                      AICREVS,STRING (15) BATCHIDEN)
RECORDFORMAT  DTENTF(INTEGER  NSECS,CONTI,SPTRK,NEXT,STATE,C 
                     INTEGERNAME  MARK,PAW,PIW,C 
                     RECORDARRAY  ESCBS(0:31)(ESCBF))
RECORDFORMAT  GPCTF(BYTEINTEGER  FLAGS,DEVTYPE,SPAREB,LINK,C 
                    INTEGER  PROPS0,PROPS1,DEV ENT BASE,SPAREI,PTSM,C 
                    MNEMONIC,BYTEINTEGER  MECHINDEX,PROPS03,SERVRT,C 
                    STATE)
!
OWNINTEGERARRAYFORMAT  GPCF(0:10000)
OWNBYTEINTEGERARRAYFORMAT  CONTYPE(0:31)
!
!
!***********************************************************************
!*
!*          Subsystem and Director references
!*
!***********************************************************************
!
EXTERNALSTRINGFNSPEC  DATE
EXTERNALROUTINESPEC  DEFINE(STRING (255) S)
SYSTEMSTRINGFNSPEC  ITOS(INTEGER  N)
SYSTEMROUTINESPEC  OPER(INTEGER  OPERNO,STRING (255) S)
EXTERNALSTRINGFNSPEC  TIME
EXTERNALINTEGERFNSPEC  UINFI(INTEGER  N)
EXTERNALSTRINGFNSPEC  UINFS(INTEGER  N)
!
!
!***********************************************************************
!*
!*          Own variables
!*
!***********************************************************************
!
OWNINTEGER  REASON = -1
OWNINTEGER  OPERNO
OWNINTEGER  CHARCOUNT
OWNSTRING (50) OPBUFF
!
!
!***********************************************************************
!*
!*          Service routines
!*
!***********************************************************************
!
ROUTINE  INITIALISE
RECORDNAME  DIRINF(DIRINFF)
!
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
BYTEINTEGER  CH
!
IF  REASON # 1 THEN  PRINTSTRING(S) AND  RETURN ;   ! Not on OPER
!
L = LENGTH(S)
RETURN  IF  L = 0
!
CYCLE  I = 1,1,L
   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)FN  MTOS(INTEGER  M)
INTEGER  I,J,A
STRING (4) S
!
A = ADDR(M)
J = 0
CYCLE  I = 0,1,3
   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
!
!
STRING (1)FN  HTOS(INTEGER  N)
INTEGER  C
!
IF  0 <= N <= 9 THEN  START 
   C = N + '0'
FINISH  ELSE  START 
   C = N - 10 + 'A'
FINISH 
RESULT  = TOSTRING(C)
END ;   ! of HTOS
!
!
!***********************************************************************
!*
!*          D I S C S
!*
!***********************************************************************
!
EXTERNALROUTINE  DISCS(STRING (255) PARMS)
RECORDNAME  COM(COMF)
RECORDNAME  DDTENT(DDTFORM)
SWITCH  DDTSTATE(0:13)
STRING (255) S
STRING (4) TYPE
STRING (8) LAB
INTEGER  I,NDISCS,DITPTR,ALL,CYLS
!
INITIALISE
IF  PARMS = ".ALL" THEN  ALL = 1 ELSE  ALL = 0
COM == RECORD(COM RECORD)
NDISCS = COM_NDISCS;   ! Number of disc drives
DITPTR = COM_DITADDR;  ! Address of DIT
!
CYCLE  I = 1,1,NDISCS
   LAB = ""
   DDTENT == RECORD(INTEGER(DITPTR))
   IF  DDTENT_MNEMONIC >> 16 = DMNEM THEN  -> NODISC 
   -> DDTSTATE(DDTENT_STATE)
   !
   DDTSTATE(0):
   DDTSTATE(1):
   DDTSTATE(2):
   DDTSTATE(3):   S = "unloaded"
                  -> OUT
   !
   DDTSTATE(4):
   DDTSTATE(5):
   DDTSTATE(6):
   DDTSTATE(10):  S = "loaded "
                  -> LABEL
   !
   DDTSTATE(7):
   DDTSTATE(8):   S = "awaiting reload"
                 -> OUT
   !
   DDTSTATE(9):   S = "?????"
                  -> OUT
   !
   DDTSTATE(11):
   DDTSTATE(12):
   DDTSTATE(13):  S = "priv   "
                  -> LABEL
   !
LABEL:
   IF  DDTENT_LAB = "NOLABL" THEN  START 
      LAB = "no label"
      TYPE = ""
   FINISH  ELSE  START 
      LAB = DDTENT_LAB
      IF  DDTENT_BASE = 0 THEN  TYPE = "FRGN" ELSE  TYPE = "EMAS"
   FINISH 
   S = S.LAB." ".TYPE
OUT:
   PRINT(MTOS(DDTENT_MNEMONIC)." ")
   IF  ALL = 1 THEN  START 
      CYLS = INTEGER(DDTENT_PROPADDR+4)
      IF  CYLS = 404 THEN  PRINT("[EDS100] ")
      IF  CYLS = 808 THEN  PRINT("[EDS200] ")
   FINISH 
   PRINT(S.SNL)
!
NODISC:
   DITPTR = DITPTR + 4
REPEAT 
END ;   ! of DISCS
!
!
!***********************************************************************
!*
!*          S T O R E
!*
!***********************************************************************
!
EXTERNALROUTINE  STORE(STRING (255) PARMS)
INTEGER  RESIDENT,ALL,I,SMACS
RECORDNAME  COM(COMF)
!
INITIALISE
IF  PARMS = ".ALL" THEN  ALL = 1 ELSE  ALL = 0
COM == RECORD(COM RECORD)
!
IF  ALL = 1 THEN  START 
   PRINT("SMAC numbers present:")
   SMACS = COM_SMACS
   CYCLE  I = 0,1,31
      IF  (SMACS >> (31-I)) & 1 # 0 THEN  START 
         PRINT(" ".ITOS(31-I))
      FINISH 
   REPEAT 
   PRINT(SNL)
FINISH 
!
PRINT("Main store = ".ITOS(COM_SBLKS << 7)." Kb".SNL)
RESIDENT = (COM_SBLKS << 7) - (COM_SEPGS*COM_EPAGESIZE)
PRINT("Resident system = ".ITOS(RESIDENT)."Kb".SNL)
END ;   ! of STORE
!
!
!***********************************************************************
!*
!*          P O R T S
!*
!***********************************************************************
!
EXTERNALROUTINE  PORTS(STRING (255) PARMS)
RECORDNAME  COM(COMF)
!
INITIALISE
COM == RECORD(COM RECORD)
IF  COM_NOCPS = 1 THEN  START 
   PRINT("OCP is on port ".ITOS(COM_OCPPORT0).SNL)
FINISH  ELSE  START 
   PRINT("OCP 0 is on port ".ITOS(COM_OCPPORT0)."   (IPL)".SNL)
   PRINT("OCP 1 is on port ".ITOS(COM_OCPPORT1).SNL)
FINISH 
IF  COM_NSACS = 1 THEN  START 
   PRINT("SAC is on port ".ITOS(COM_SACPORT0).SNL)
FINISH  ELSE  START 
   PRINT("SAC 0 is on port ".ITOS(COM_SACPORT0)."   (IPL)".SNL)
   PRINT("SAC 1 is on port ".ITOS(COM_SACPORT1).SNL)
FINISH 
END ;   ! of PORTS
!
!
!***********************************************************************
!*
!*          T R U N K S
!*
!***********************************************************************
!
EXTERNALROUTINE  TRUNKS(STRING (255) PARMS)
RECORDNAME  COM(COMF)
BYTEINTEGERARRAYNAME  CONTABLE
SWITCH  TYPE(1:3)
STRING (4) MNEM
INTEGER  CODE,I,J,ALL,FIRSTSACPORT,LASTSACPORT,SACPORT,NSACS
!
INITIALISE
IF  PARMS = ".ALL" THEN  ALL = 1 ELSE  ALL = 0
COM == RECORD(COM RECORD)
CONTABLE == ARRAY(COM_CONTYPEA,CONTYPE)
NSACS = COM_NSACS
IF  NSACS = 1 THEN  START 
   FIRSTSACPORT = COM_SACPORT0
   LASTSACPORT = COM_SACPORT0
FINISH  ELSE  START 
   FIRSTSACPORT = 0
   LASTSACPORT = 1
FINISH 
!
CYCLE  SACPORT = FIRSTSACPORT,1,LASTSACPORT
   PRINT("SAC on port ".ITOS(SACPORT).":".SNL)
   CYCLE  J = 0,1,15
      I = SACPORT*16+J
      CODE = CONTABLE(I)
      IF  1 <= CODE <= 3 THEN  START 
         IF  ALL = 1 THEN  START 
            PRINT("   Trunk ".ITOS(J)." reports ")
         FINISH  ELSE  START 
            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)
RECORDNAME  COM(COMF)
RECORDNAME  G(GPCTF)
INTEGERARRAYNAME  GPCT
INTEGER  I,GPCA,PT,SLOTNO,LASTSLOT,GPCT BASE,STRM,NGPCS
!
INITIALISE
COM == RECORD(COM RECORD)
GPCA = COM_GPCA
GPCT == ARRAY(GPCA,GPCF)
GPCT BASE = ADDR(GPCT(GPCT(1)))
LASTSLOT = GPCT(2)
NGPCS = GPCT(3)
!
CYCLE  I = 1,1,NGPCS
   PT = GPCT(15+I) & X'FF'
   PRINT("GPC on port ".ITOS(PT>>4).", trunk ".ITOS(PT&X'F').":".SNL)
   CYCLE  SLOTNO = 0,1,LASTSLOT
      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)
RECORDNAME  COM(COMF)
INTEGER  I,FOUNDMAP,AVMAP,ALL
!
INITIALISE
IF  PARMS = ".ALL" THEN  ALL = 1 ELSE  ALL = 0
COM == RECORD(COM RECORD)
!
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 = 1 THEN  PRINT("Front end processors:".SNL)
!
CYCLE  I = 0,1,9
   IF  (FOUNDMAP >> I) & 1 = 0 THEN  CONTINUE 
   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
RECORDNAME  COM(COMF)
RECORDNAME  DTENT(DTENTF)
STRING (255) S
!
INITIALISE
COM == RECORD(COM RECORD)
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)
RECORDNAME  COM(COMF)
INTEGER  DIRVSN,IPLDEV,I
STRING (7) V
!
INITIALISE
COM == RECORD(COM RECORD)
IF  REASON = 1 THEN  V = "vsn" ELSE  V = "version"
!
PRINT("Supervisor ".V." = ".STRING(ADDR(COM_SUPVSN)).SNL)
PRINT("OCP is a ".UINFS(10).SNL)
IPLDEV = COM_IPLDEV & X'FFF'
PRINT("IPL from ")
CYCLE  I = 8,-4,0
   PRINT(HTOS((IPLDEV >> I) & X'F'))
REPEAT 
PRINT(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)
INITIALISE
!
IF  PARMS # "" THEN  START 
   DEFINE("1,".PARMS)
   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