SYSTEMSTRING (8)FNSPEC  HTOS(INTEGER  VALUE, PLACES)
EXTERNALROUTINE  PMON(STRING (255)S)
EXTERNALROUTINESPEC  CLEAR(STRING (255)S)
RECORDFORMAT  RF(INTEGER  ADR, TYPE, START, END)
SYSTEMROUTINESPEC  CONNECT(STRING (31)FILE, INTEGER  M, H, P,
      RECORD (RF)NAME  R, INTEGERNAME  FLAG)
EXTERNALROUTINESPEC  DEFINE(STRING (255)S)
SYSTEMSTRINGFNSPEC  ITOS(INTEGER  N)
SYSTEMROUTINESPEC  PHEX(INTEGER  I)
EXTERNALINTEGERFNSPEC  DMON(STRING (255)S)
EXTERNALINTEGERFNSPEC  DCONNECT(STRING (6)U, STRING (11)F,
      INTEGER  FSYS, MODE, APF, INTEGERNAME  SEG, GAP)
EXTERNALINTEGERFNSPEC  DDISCONNECT(STRING (6)U, STRING (11)F,
      INTEGER  FSYS, DSTRY)
INTEGER  J, SEG, GAP, A, C, K, W, IC, ICD, PAGE, TOPJ2, Y
INTEGER  N, W1, OFFSETS
STRING (31)WS
STRING (11)USER, FILE
RECORDFORMAT  HF(INTEGER  NEXT, RELST, MAX, A, B, C, CYCLIC, C 
      READ)
RECORD (HF)NAME  H
STRING (18)ARRAY  ST(0:255)
RECORDFORMAT  KYF(STRING (31)NAME, INTEGER  OFFSET)
RECORD (RF)R2
RECORD (KYF)ARRAYFORMAT  KYSF(0:1023)
RECORD (KYF)ARRAYNAME  KYS
CONSTSTRING (15)ARRAY  PRE(0:15) = C 
"Page in        ",
"Page out       ",
"Page out - w   ",
"Strobe out     ",
"Strobe out - W ",
"Snooze         ",
"Change Context ",
"Re-schedule    ",
"               ",
"               ",
"               ",
"               ",
"               ",
"               ",
"Disconnect seg ",
"Connect segment"
!
CONSTSTRING (13)ARRAY  RESCH(1:3) = C 
"suspended    ",
"out of time  ",
"out of Epages"
!
      IF  S = "ON" OR  S = "LATER" START 
         J = DMON(S)
         -> OUT
      FINISH 
!
      USER = "VOLUMS" AND  FILE = "PAGEFAULTS" C 
      UNLESS  S -> USER . (".") . FILE
!
      J = DMON("")
      RETURN  IF  S = "NO"
!
      OFFSETS = 0
      CONNECT("ERCC10.OFFSETS_SEG2", 1, 0, 0, R2, J)
      -> NO OFFSETS UNLESS  J = 0
      KYS == ARRAY(R2_ADR+R2_START, KYSF)
      TOPJ2 = INTEGER(R2_ADR + 16) - 1
      OFFSETS = 1
NO OFFSETS:
      SEG = 0
      GAP = 0
      K = DCONNECT(USER, FILE, -1, 1, 0, SEG, GAP)
      J = K AND  -> OUT UNLESS  K = 0 OR  K = 34
      A = SEG << 18
      H == RECORD(A)
!
      CYCLE  J = 0, 1, 255
         ST(J) = ""
      REPEAT 
      ST(2) = "DIRECTOR"
      ST(3) = "#DGLA"
      ST(4) = "#STK"
      ST(6) = "#SIGSTK"
      ST(8) = "SYSTEM CALL TABLE"
      ST(9) = "UINF"
      ST(14) = "DIRLOG"
      ST(32) = "SUBSYSTEM"
      ST(34) = "#BGLA"
!
      DEFINE("61,T#OUT")
      SELECT OUTPUT(61)
!
      IC = 0
      J = H_RELST
      WHILE  J < H_NEXT CYCLE 
         W = INTEGER(A+J)
         C = W >> 28
         PRINTSTRING(PRE(C))
         IF  C >= 14 START 
            SEG = BYTEINTEGER(A+J+1)
            WS = STRING(A+J+2)
            WRITE(SEG, 3)
            SPACE
            PRINTSTRING(WS)
            WS = "" IF  C = 14
            ST(SEG) = WS
            J = J + 16
            -> NEXT
         FINISH 
         W = W << 4 >> 4
         ICD = IC-W
         ICD = 0 IF  ICD < 0
         WRITE(ICD, 6)
         IC = W
         W = INTEGER(A+J+4)
         SEG = W >> 18
         PAGE = W << 14 >> 26
!
         SPACE
         IF  C = 5 OR  C = 6 START ; ! SNOOZE or Change Context
            WRITE(W, 1)
            PRINTSTRING(" pages")
            -> NEXT
         FINISH 
!
         IF  C = 7 START ; ! reschedule
            N = W >> 24
            IF  1 <= N <= 3 C 
            THEN  PRINTSTRING(RESCH(N)) C 
            ELSE  PRINTSTRING("reason ".ITOS(N))
!
            N = W << 8 >> 24
            PRINTSTRING(" category ".ITOS(N))
!
            N = W << 16 >> 16
            PRINTSTRING(" working set size ".ITOS(N))
            -> NEXT
         FINISH 
!
         IF  ST(SEG) = "" C 
         THEN  PRINTSTRING("SEG ".ITOS(SEG)) C 
         ELSE  PRINTSTRING(ST(SEG))
         PRINTSTRING(" PAGE X'".HTOS(PAGE, 2))
         IF  C = 0 START ; ! page in
            PRINTSTRING(".".HTOS(W&(31<<7), 3))
!
            IF  SEG = 2 AND  OFFSETS = 1 START 
               W = W & X'3FF80'
               N = 0; ! number of names found
               CYCLE  Y = 0, 1, TOPJ2
!
            W1 = KYS(Y)_OFFSET & X'3FF80'
            IF  W1 = W START ; ! plausible name
               PRINTSTRING("   ".KYS(Y-1)_NAME) IF  N = 0
               PRINTSTRING("/" . KYS(Y)_NAME)
               N = N + 1
            FINISH  ELSE  START 
               IF  W1 > W START ; ! gone past
                  PRINTSTRING("   ".KYS(Y-1)_NAME) IF  N = 0
                  EXIT 
               FINISH 
            FINISH 
!
               REPEAT 
            FINISH 
!
         FINISH 
NEXT:
         J = J + 8
         NEWLINE
      REPEAT 
      J = 0
      J = DDISCONNECT(USER, FILE, -1, 0) IF  K = 0
!
      SELECT OUTPUT(0)
      CLOSE STREAM(61)
      CLEAR("61")
      PRINTSTRING("T#OUT written ")
OUT:
      PRINTSTRING("Flag =")
      WRITE(J, 1)
      NEWLINE
END 
ENDOFFILE