!* COMMUNICATIONS RECORD FORMAT - EXTANT FROM CHOPSUPE 21B ONWARDS *
RECORDFORMAT  COMF(INTEGER  OCPTYPE,IPLDEV,SBLKS,SEPGS,NDISCS,  C 
         DLVNADDR,GPCTABSIZE,GPCA,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,RESV2,OCPPORT1,OCPPORT0, C 
         INTEGER  ITINT,CONTYPEA,GPCCONFA,FPCCONFA,SFCCONFA, C 
         BLKADDR,RATION,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,  C 
         MAXCBT,PERFORMAD,SP1,SP2,SP3,SP4,SP5,SP6, 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. Each entry is now
! described in more detail:-
!
!     OCPTYPE     The 2900 Processor on this configuration as follows
!                 1 = 2950 or S1
!                 2 = 2960 or P2
!                 3 = 2970 or P3
!                 4 = 2980 or P4
!                 5 = 2972 or non-interleaved 2976 (P4/1)
!                 6 = Interleaved 2976 or P4/1
!
!     IPLDEV      The port/trunk/stream(or DCU/stream) of the
!                 device used at IPL time.
!     SBLKS       The no of 128k blocks of main store present
!     SEPGS       The no of extended pages for paging(ie not including
!                 any pages occupied by resident code  & data).
!     NDISCS      Then number of EDS drives avaliable
!     DLVNADDR    The address of an array which maps disc lvns to
!                 their ddt slots.
!     GPCTABSIZE  The size in bytes of the GPC (or DCU) table
!     GPCA        The address of the GPC (or DCU) table
!     SFCTABSIZE  The size of the SFC(ie DRUM) table
!     SFCA        The address of the SFC table
!     SFCK        The number of (useable) 1K page frames of Drum store
!                 available for paging.(0 = No drum configuration)
!     DIRSITE     The Director site address(eg X200) no longer reqd?
!     DCODEDA     The Disc Address of the Director (expressed as
!                 SUPLVN<<24!DIRSITE)
!     SUPLVN      The logical volume no of the disc from which the 
!                 Sytem was "SLOADED". Various System components (eg
!                 DIRECT, VOLUMS will page from here
!
!     TOJDAY      Todays (Julien) day number.
!     DATE0}      These three integers define the current date(updated at
!     DATE1}      at 2400) as a character string such that
!     DATE2}      the length byte is in the bottom of DATE0
!
!     TIME0}      These three integers define the clock time as a string
!     TIME1}      in the same format as for DATE. The time is updated
!     TIME2}      about every 2 seconds
!
!     EPAGESIZE   The number of 1K pages combined together to make up
!                 the logical "Extended Page" used in Emas.Currently=4
!     USERS       The number of user processes (foreground+background)
!                 currently in existence.Includes DIRECT,VOLUMS&SPOOLR
!     CATTAD      Address of maxcat followed by category table.
!     SERVAAD     The address of the service array SERVA.
!     NSACS       The number of sacs found at grope time
!     SACPORT1}   Holds the Port no of the Store Access Controller(s)
!     SACPORT0}   found at grope time. SACPORT0 was used to IPL system.
!     NOCPS       The number of OCPS found at grope time.
!     OCPPORT1}   Hold the Port no of the OCPs found at grope time.
!     OCPPORT0}   OCPPORT0 was used to IPL the system.
!     ITINT       The Interval Timer interval in microsecs.  Varies
!                 between different members of the range
!     CONTYPEA    The address of a 31 byte area containing the codes
!                 of the controllers in port-trunk order. Codes are:-
!                 0 = Not relevant to EMAS
!                 1 = SFC1
!                 2 = FPC2
!                 3 = GPC1
!
!     GPCCONFA}   These three variables each point to a word array
!     FPCCONFA}   containing controller data. The first word in each
!     SFCCONFA}   case says how many controllers on the system. The
!                 remainder have Port&Trunk in top byte and Public
!                 segment no of comms segment in bottom byte. For GPCS
!                 the Public Seg no is apparently omitted!
!     BLKADDR     The address of first element of a word array bounds
!                 (1:SBLKS) containing the real address of each 128K
!                 block of main store. Real addresses are in the form
!                 RSN/SMAC NO/Address in SMAC
!     RATION      Information maintained by DIRECT concerning access
!                 rationing. Bytes from left indicate scarcity,
!                 pre-empt point, zero and interactive users
!                 respectively
!     SMACS       Bits 0-15 are a map of SMACS in use by the system.
!                 2**16 bit set if SMAC0 in use etc.
!                 Bits 16-31 are a map of SMACS found at grope time.
!                 2**0 bit set if SMAC0 found etc.
!     TRANS       The address of a 768 byte area containing 3 translate
!                 tables. The first is ISO to EBCDIC, the second the
!                 exact converse & the third is ISO to ISO with
!                 lower to upper case conversion.
!     KMON        A 64 bit bitmask controlling monitoring of Kernel
!                 services. Bit 2**n means monitor service n. Bits can
!                 be set by Operator command KMON.
!     DITADDR     Disc  index table address. The address of first
!                 element of an array(1:NDISCS)  containing the address
!                 of the disc device entries. Needed for S series and
!                 provided for compatablity on P series
!     SMACPOS     The no of places that the Smac no must be left
!                 shifted to be in the right position to access
!                 a Smac image store location. Incredibly this varies
!                 between  the 2980 and others!!
!     SUPVSN      The Supervisor id no as a three char string eg 22A
!     PSTVA       The virtual address of the Public Segment table which
!                 is itself a Public segment. All other information
!                 about PST can be found by looking at its own PST entry
!     SECSFRMN    The no of Seconds since midnight. Updated as for TIME
!     SECSTOCD    The number of seconds to System closedown if positive
!                 If zero or negative no close down time has yet been
!                 notified.  Updated as for TIME
!     SYNC1DEST}  These are the service nos N2,N3 & N4 for process
!     SYNC2DEST}  parameter passing described in Supervisor Note 1
!     ASYNCDEST}
!     MAXPROCS    The maximum number of paged processes that the
!                 Supervisor is configured to run. Also the size
!                 of the Process array.
!     INSPERSECS  The number of instructions the OCP executes in 1 
!                 second divided by 1000(Approx average for EMAS)
!     ELAPHEAD    The head of a linked list of param cells holding
!                 service with an elapsed interval interrupt request
!                 outstanding
!     COMMSRECA   The address of an area containing details of the
!                 Communication streams.(private to COMMS Control)
!     STOREAAD    The address of first element of the store record array
!                 bounds (0:SEPGS-1)
!     PROCAAD     The address of first element of the process record
!                 array bounds(0:MAXPROCS)
!     SFCCTAB}    The addresses of two private tables provided by grope
!     DRUMTAD}    for use by the routine DRUM. They give details of
!                 the SFCS and DRUMS found on the system
!     TSLICE      Time slice in microsecs. Supervisor has to allow for 
!                 differences in interval timer speeds accross the range
!     FEPS        Bits 0-15 are a map of FEPs found at grope time.
!                 2**16 bit set if FE0 found etc.
!                 Bits 16-31 are a map of currently available FEPs.
!                 2**0 bit set if FE0 available etc.
!     MAXCBT      Maximum cbt entry
!     PERFORMAD   Address of record containing timing and counts for
!                 performance anlysis.
!     SP1->SP6    Spare locations
!     LSTL}
!     LSTB}
!     PSTL}
!     PSTB}       These are the image store addresses for the following
!     HKEYS}      control registers:-
!     HOOT}       Local Segment Table Limit & Base
!     SIM }       Public Segment Table Limit & Base
!     CLKX}       Handkeys,Hooter System Interrupt Mask Register
!     CLKY}       and the clock X,Y & Z Registers
!     CLKZ}
!     HBIT        A bit pattern that when ORed into Control Register
!                 "HOOT" operates the Hooter.(0=Hooterless machine)
!     SLAVEOFF    A bit pattern (top 16 bits) and Image store address
!                 in bottom 16 bits. ORing the top 16 bits(after
!                 shifting) into the image store will stop all slaving of
!                 operands but not instructions
!     INHSSR      A bit pattern and image location as for SLAVEOFF.
!                 ORing the bits into the location will switch off
!                 reporting of successful system retry
!     SDR1}
!     SDR2}       The image store addresses of SMAC internal registers
!     SDR3}       needed by the Engineers after Smac errors have 
!     SDR4}       occurred
!     SESR}
!     HOFFBIT     A bit pattern that when ORed into a Smac Engineers
!                 status register will stop reporting of error
!                 from that Smac
!
!     BLOCKZBIT   A bit pattern indicating the position of
!                 the block zero bit in the SMAC config register.
!
!     BLKSHIFT    Indicates which way to shift the BLOCKZBIT mask
!                 to correspond with subsequent store blocks.
!
!     BLKSIZE     Store block size.
!
CONSTRECORD (COMF)NAME  COM=X'80000000'+48<<18
!-----------------------------------------------------------------------
CONSTSTRING (4) ARRAY  PROCESSOR TYPE(1:6) = C 
"2950",
"2960",
"2970",
"2980",
"2972",
"2976"
!----------------------------------------------------------------------
SYSTEMSTRING (15)FNSPEC  ITOS(INTEGER  I)
SYSTEMROUTINESPEC  MOVE(INTEGER  LENGTH, FROM, TO)
EXTERNALSTRINGFNSPEC  VDUS(INTEGER  I)
EXTERNALROUTINESPEC  PRINTCHS(STRING (255)S)
EXTERNALROUTINESPEC  PROMPT(STRING (15) S)
EXTERNALROUTINESPEC  DDELAY(INTEGER  SECS)
EXTERNALSTRING (15)FNSPEC  INTERRUPT
EXTERNALINTEGERFNSPEC  STOI(STRINGNAME  S)
!-----------------------------------------------------------------------
                                        ! TIMING INFORMATION DECS.
RECORDFORMAT  PERFORMF(INTEGER  RECAPN,PTURNN,PSHAREN,NEWPAGEN, C 
                       PAGEOUTN,PAGEZN,SNOOZN,ABORTN,SNOOZOK, C 
                       SNOOZTO,SNOOZAB, C 
                       LONGINTEGER  CLOCK, C 
                       LONGINTEGERARRAY  SERVIT,SERVIC(0:LOCSN0+3), C 
                       INTEGERARRAY  SERVN(0:LOCSN0+3))
OWNRECORD (PERFORMF) OLDTIMES=0,PERFORM=0
CONSTSTRING (15)ARRAY  SERVROUT(0:LOCSN0+3)="IDLE TIME",
  "NOWORK TIME","DEADLOCK RCVRY","SCHEDULE",
  "PAGETURN","GET EPAGE","RETURN EPAGE","FILE SEMAPHORE","ACTIVE MEM",
  "","ELAPSEDINT","UPDATE TIME","DPONPUTONQ","TURNON ER",
  "ACTIVEMEM(POLL)","SCHEDULE(OPER)","OVERALLOC CNTRL",""(15),
  "DISC","DISC TRANSFERS","DISC INTERRUPT","","MOVE REQUESTS",
  "MOVE TRANSFERS",""(2),
  "DRUM TRANSFERS","","DRUM INTERRUPT",""(5),"GPC REQUESTS","TAPE",
  "OPER","LP ADAPTOR","CR ADAPTOR","CP ADAPTOR","PRINTER",
  "COMMS CONTROL","COMBINE","FEP ADAPTOR","GPC INTERRUPT",
  ""(2),"BMREP","COMREP",""(2),"LOCAL CONTROL","FOREGRND USERS",
  "BACKGRND USERS"
!-----------------------------------------------------------------------
                                        ! SCHEDULING CATEGORY TABLES
RECORDFORMAT  CATTABF(BYTEINTEGER  PRIORITY,EPLIM,RTLIM,MOREP,MORET, C 
      LESSP,SP0,SUSP,RQTS1,RQTS2,STROBEI,SP2)
!-----------------------------------------------------------------------
                                        ! PROCESS INORMATION ETC.
RECORDFORMAT  PROCF(STRING (6) USER, C 
      BYTEINTEGER  INCAR, CATEGORY, P4TOP4,  RUNQ, ACTIVE, C 
      INTEGER  ACTW0, LSTAD, BYTEINTEGER  EPA,EPN,HALFINTEGER  LAMTX,C 
      INTEGER  STACK, STATUS)
                                        !     2**0 = HOLDS A SEMAPHORE
                                        !     2**1 = ON A PAGE FAULT
                                        !     2**2 = A BACKGROUND JOB
                                        !     2**3 = DEALLOCATING AMT (&DRUM) ONLY
                                        !     2**4 = AMT LOST
                                        !     2**5 = HAD TIME ON FLY
                                        !     2**6 = HAD EPAGES ON FLY
                                        !     2**7 = SNOOZING
                                        !     2**8 = LC STACK READ FAILURE
                                        !     2**9 = STATE X(LC STK SNOOZED)
                                        !     REMAINDER UNUSED
CONSTSTRING (31) ARRAY  STATES(0:9)= C 
"holds sema",
"page fault",
"",
"dealoc AMT",
"AMT lost  ",
"Time on fly",
"Pages on fly",
"snoozing  ",
"LC failed ",
"LC snoozed"
!-----------------------------------------------------------------------
!
!
EXTERNALROUTINE  PRINT CATEGORY TABLE(string (63) s)
INTEGER  MAXCAT
      MAXCAT=INTEGER(COM_CATTAD)
RECORD (CATTABF)ARRAYFORMAT  CATTABAF(0:MAXCAT)
RECORD (CATTABF)ARRAYNAME  CATTAB
      CATTAB==ARRAY(COM_CATTAD+4,CATTABAF)
INTEGER  I
print string(string(ADDR(COM_SUPVSN))." ")
print string("Dual") if  com_nocps#1
print string(processor type(com_ocptype))
print string("  Store=")
write(com_sblks*128,0)
print string("K  Page size=")
write(com_epagesize,0)
print string("K  Time slice=")
print(com_tslice/1000000,1,4)
printstring("s ")
print string(string(addr(Com_date0)+3)." ".string(addr(com_time0)+3))
newline
PRINT STRING( c 
"Category  Priority  Store Time  More  More  Less  Wait  RQueue  RQueue  Strobe")
newline
print string( c 
"            queue   limit limit Store Time  Store       Slice1  Slice2  Time")
NEWLINE
FOR  I=1,1,MAX CAT CYCLE 
  WRITE(I,2)
  if  cattab(i)_Sp0='B' then  print string(" Back") else  print string(" Fore")
  WRITE(CATTAB(I)_PRIORITY,6)
  WRITE(CATTAB(I)_EPLIM*com_epagesize,7) ; print symbol('K')
  PRINT((CATTAB(I)_RTLIM*com_tslice)/1000000,2,2) ; print symbol('s')
  WRITE(CATTAB(I)_MOREP,4)
  WRITE(CATTAB(I)_MORET,5)
  WRITE(CATTAB(I)_LESSP,5)
  WRITE(CATTAB(I)_SUSP,4)
  WRITE(CATTAB(I)_RQTS1,6)
  WRITE(CATTAB(I)_RQTS2,6)
  if  CATTAB(I)_STROBEI#0 START 
    print((CATTAB(I)_STROBEI*com_tslice)/1000000,5,2); print symbol('s')
  finish 
  NEWLINE
REPEAT 
prompt("")
readsymbol(i) while  i#nl
END 
!
!
EXTERNALROUTINE  PRINT PROCESS LIST(STRING (63) S)
RECORD (PROCF)ARRAYFORMAT  PROCAF(0:MAXPROCS)
RECORD (PROCF)ARRAYNAME  PROCA
PROCA==ARRAY(COM_PROCAAD,PROCAF)
INTEGER  MAXCAT
      MAXCAT=INTEGER(COM_CATTAD)
RECORD (CATTABF)ARRAYFORMAT  CATTABAF(0:MAXCAT)
RECORD (CATTABF)ARRAYNAME  CATTAB
      CATTAB==ARRAY(COM_CATTAD+4,CATTABAF)
record (procf)name  proc
integer  i,J
for  i=1,1,maxprocs cycle 
  proc==proca(i)
  if  proc_user#"" and  (s="" or  proc_user=s) start 
    write(i,3)
    if  proc_status&4#0 then  print symbol('*') else  space
    print string(proc_user)
    write(proc_category,2)
    if  proc_p4top4#0 then  write(proc_p4top4,3) else  spaces(4)
    if  proc_active=255 start 
      if  proc_status&2=0 start 
        if  proc_status&8=0 start 
          if  proc_runq#0 start 
            print string("   run Q")
            write(proc_runq,1)
          finish  else  start 
            print string(" Store Q")
            write(cattab(proc_category)_priority,1)
          finish 
          space
         finish  else  print string(" ".states(3))
      finish  else  print string(" ".states(1))
      spaces(7)
    finishelsestart 
      for  j=0,1,9 cycle 
        if  j#0 and  j#1 and  j#3 and  j#5 and  j#6 and  c 
          proc_status&(1<<j)#0 and  states(j)#"" start 
          print string(" ".states(j))
          exit 
        finish 
      repeat 
      if  proc_active#0 start 
        write(proc_active*20,4)
        print string(" s")
      finish  else  spaces(7)
    finish 
    if  proc_epa#0 start 
      print string(" pages")
      write(proc_epa,3)
      print string(" used")
      write(proc_epn,3)
    finish else  spaces(19)
    print string(" ".states(0)) if  proc_status&1#0 and  proc_active=255
    print string(" ".states(5)) if  proc_status&32#0 and  proc_active=255
    print string(" ".states(6)) if  proc_status&64#0 and  proc_active=255
    print string(" ".states(7)) if  proc_status&128#0 and  proc_active=255
    print string(" ".states(9)) if  proc_status&512#0 and  proc_active=255
    newline
    exit  if  s=proc_user
  finish 
repeat 
END 
!
!
EXTERNALROUTINE  WATCH(STRING (63) S)
STRING (63) INT,TEMP
INTEGER  SECONDS
  IF  S->S.(",").TEMP THEN  SECONDS=STOI(TEMP) ELSE  SECONDS=2
  CYCLE 
    PRINTPROCESSLIST(S)
    DDELAY(SECONDS)
    INT=INTERRUPT
    EXIT  IF  INT="STOP" OR  INT="stop"
  REPEAT 
END 

LONGINTEGERFN  CLOCK
LONGINTEGER  L
  *RRTC_0
  *ST_L
  RESULT =(L>>33<<32!L&X'0FFFFFFFF')<<1
END ; ! OF CLOCK
!
!
ROUTINE  GET SUPERVISOR TIME
RECORD (PERFORMF) NEWTIMES
INTEGER  I
MOVE((11+2+5*68)*4,COM_PERFORMAD,ADDR(NEWTIMES))
PERFORM_CLOCK=CLOCK
OLDTIMES_CLOCK=NEWTIMES_CLOCK IF  OLDTIMES_CLOCK=0
NEWTIMES_CLOCK=PERFORM_CLOCK
PERFORM_RECAPN=NEWTIMES_RECAPN-OLDTIMES_RECAPN
PERFORM_PTURNN=NEWTIMES_PTURNN-OLDTIMES_PTURNN
PERFORM_PSHAREN=NEWTIMES_PSHAREN-OLDTIMES_PSHAREN
PERFORM_NEWPAGEN=NEWTIMES_NEWPAGEN-OLDTIMES_NEWPAGEN
PERFORM_PAGEOUTN=NEWTIMES_PAGEOUTN-OLDTIMES_PAGEOUTN
PERFORM_PAGEZN=NEWTIMES_PAGEZN-OLDTIMES_PAGEZN
PERFORM_SNOOZN=NEWTIMES_SNOOZN-OLDTIMES_SNOOZN
PERFORM_ABORTN=NEWTIMES_ABORTN-OLDTIMES_ABORTN
PERFORM_SNOOZOK=NEWTIMES_SNOOZOK-OLDTIMES_SNOOZOK
PERFORM_SNOOZTO=NEWTIMES_SNOOZTO-OLDTIMES_SNOOZTO
PERFORM_SNOOZAB=NEWTIMES_SNOOZAB-OLDTIMES_SNOOZAB
PERFORM_CLOCK=NEWTIMES_CLOCK-OLDTIMES_CLOCK
FOR  I=0,1,LOCSN0+3 CYCLE 
  PERFORM_SERVIT(I)=NEWTIMES_SERVIT(I)-OLDTIMES_SERVIT(I)
  PERFORM_SERVIC(I)=NEWTIMES_SERVIC(I)-OLDTIMES_SERVIC(I)
  PERFORM_SERVN(I)=NEWTIMES_SERVN(I)-OLDTIMES_SERVN(I)
REPEAT 
PERFORM_SERVIC(0)=PERFORM_SERVN(0)
PERFORM_SERVIC(1)=PERFORM_SERVN(1)
OLDTIMES=NEWTIMES
END 


EXTERNALROUTINE  PRINT SUPERVISOR TIME(STRING (63) SS)
INTEGER  I,J,K
LONGREAL  PERIOD,TOTAL,SERVTIME
STRING  (15) S
GET SUPERVISOR TIME
      printchs(VDUS(1));           !clear screen if its a VDU
      I=ADDR(COM_DATE0)+3
      PRINT STRING("
EMAS2900 SUP".STRING(ADDR(COM_SUPVSN))." TIMING ". C 
STRING(I)." ".STRING(I+12). C 
"  PERIOD=")
      PRINT(PERFORM_CLOCK/1000000,1,1)
      PRINT STRING(" SECS")
      PERIOD=PERFORM_CLOCK*COM_NOCPS
      PRINT STRING("
  SERVICE            CALLS      TIME(SECS)     AVERAGE(MSECS)  %OF TOTAL
")
      TOTAL=0
      CYCLE  I=0,1,LOCSN0+3
         S=SERVROUT(I)
         SERVTIME=COM_ITINT*PERFORM_SERVIT(I)
         IF  S#"" AND  PERFORM_SERVN(I)#0 START 
            PRINT STRING(S)
            SPACES(16-LENGTH(S))
            PRINT(PERFORM_SERVN(I),9,0)
            PRINT(SERVTIME/1000000,11,3)
            PRINT((SERVTIME/1000)/PERFORM_SERVN(I),10,3)
            PRINT(100*SERVTIME/PERIOD,7,1)
            PRINT STRING("%
")
         FINISH 
         TOTAL=TOTAL+SERVTIME
      REPEAT 
      PRINT STRING("INT/ACT/SEMA ETC.")
      SPACES(9)
      PRINT((PERIOD-TOTAL)/1000000,11,3)
      SPACES(20)
      PRINT(100*(PERIOD-TOTAL)/PERIOD,2,1)
      PRINT STRING("%
")
END 
!
!
externalroutine  PRINT SUPERVISOR paging(string (63) s)
INTEGER  I
get supervisor time
      printchs(VDUS(1));           !clear screen if its a VDU
      I=ADDR(COM_DATE0)+3
      PRINT STRING("
EMAS2900 SUP".STRING(ADDR(COM_SUPVSN))." PAGING ". C 
STRING(I)." ".STRING(I+12). C 
"  PERIOD=")
      PRINT(PERFORM_CLOCK/1000000,1,3)
      PRINT STRING(" SECS")
      PRINTSTRING("
PAGEINS=".ITOS(PERFORM_PTURNN)."
RECAPTURES=".ITOS(PERFORM_RECAPN)."
SHARED PAGES=".ITOS(PERFORM_PSHAREN)."
NEW PAGES=".ITOS(PERFORM_NEWPAGEN)."
WRITEOUTS=".ITOS(PERFORM_PAGEOUTN)."
PAGES ZEROED=".ITOS(PERFORM_PAGEZN)."
PAGES SNOOZED=".ITOS(PERFORM_SNOOZN)."
PAGES ABORTED=".ITOS(PERFORM_ABORTN))
      PRINTSTRING("
SNOOZES COMPLETE =".ITOS(PERFORM_SNOOZOK)."
SNOOZES TIMEDOUT =".ITOS(PERFORM_SNOOZTO)."
SNOOZES ABANDONED=".ITOS(PERFORM_SNOOZAB)."
")
end 


recordformat  tabf(string (15) s, integer  percent)
routine  print table(record (tabf)arrayname  table, integer  n,limit, c 
  string (255) t)
integer  i,j
 record (tabf) temp
 cycle 
   j=0
   for  i=0,1,n-1 cycle 
     if  table(i)_percent<table(i+1)_percent start 
       temp=table(i)
       table(i)=table(i+1)
       table(i+1)=temp
       j=1
     finish 
   repeat 
   exit  if  j=0
 repeat 
  n=20 if  n>20
  spaces((72-length(t))//2)
  printstring(t)
  newline
  spaces(17)
  write(i,4) for  i=0,10,100
  newline
  for  i=0,1,n cycle 
    exit  if  table(i)_percent<limit
    print string(table(i)_s)
    spaces(16-length(table(i)_s))
    write(table(i)_percent,2)
    print string("% ")
    printsymbol('*') for  j=0,1,table(i)_percent//2
    newline
  repeat 
END 
!
!
EXTERNALROUTINE  PRINT TIME(STRING (63) S)
ROUTINESPEC  TIMEOUT
GET SUPERVISOR TIME
TIMEOUT
RETURN 
!
!
ROUTINE  TIMEOUT
!***********************************************************************
!*    PRINT OUT THE SESSION TIMING MEASUREMENTS                        *
!***********************************************************************
RECORD (TABF)ARRAY  TABLE(0:LOCSN0+4)
INTEGER  I,J,K
LONGREAL  PERIOD, TOTAL,SERVTIME
STRING  (255) S,title
  I=ADDR(COM_DATE0)+3
  title="EMAS2900 SUP".STRING(ADDR(COM_SUPVSN))." MEASUREMENTS ". C 
    STRING(I)." ".STRING(I+12)." PERIOD=".ITOS(PERFORM_CLOCK//1000000)." SECS"
   PERIOD=PERFORM_CLOCK*COM_NOCPS
   k=-1
   TOTAL=0
   CYCLE  I=0,1,LOCSN0+3
     S=SERVROUT(I)
     SERVTIME=COM_ITINT*PERFORM_SERVIT(I)
     IF  S#"" AND  PERFORM_SERVN(I)#0 and  100*servtime/period>1.0 START 
       k=k+1
       table(k)_s=s
       table(k)_percent=int(100*SERVTIME/PERIOD)
     FINISH 
     TOTAL=TOTAL+SERVTIME
   REPEAT 
   K=K+1
   TABLE(K)_S="INT/ACT/SEMA"
   TABLE(K)_PERCENT=INT(100*(PERIOD-TOTAL)/PERIOD)
   printchs(vdus(1))
   print table(table,k,1,title)
END 
END 
!
!
EXTERNALROUTINE  PRINT PAGING(STRING (63) S)
ROUTINESPEC  PAGEING OUT
GET SUPERVISOR TIME
PAGEING OUT
RETURN 
!
!
ROUTINE  PAGEING OUT
RECORD (TABF)ARRAY  TABLE(0:3)
INTEGER  I,J,K
LONGREAL  PERIOD, TOTAL,SERVTIME
STRING  (255) S,title
  I=ADDR(COM_DATE0)+3
  title="EMAS2900 SUP".STRING(ADDR(COM_SUPVSN))." PAGE INS ". C 
    STRING(I)." ".STRING(I+12)." PERIOD=".ITOS(PERFORM_CLOCK//1000000)." SECS"
   TABLE(0)_S="TRANSFERS"
   TABLE(0)_PERCENT= 100*(PERFORM_PTURNN-PERFORM_RECAPN-PERFORM_PSHAREN C 
     -PERFORM_NEWPAGEN)//PERFORM_PTURNN
   TABLE(1)_S="RECAPTURES"
   TABLE(1)_PERCENT=100*PERFORM_RECAPN//PERFORM_PTURNN
   TABLE(2)_S="SHARED"
   TABLE(2)_PERCENT=100*PERFORM_PSHAREN//PERFORM_PTURNN
   TABLE(3)_S="NEWPAGES"
   TABLE(3)_PERCENT=100*PERFORM_NEWPAGEN//PERFORM_PTURNN
   printchs(vdus(1))
   print table(table,3,0,title)
END 
END 
ENDOFFILE