 TITLE '* * *   CAL Performance Monitor * * * F00 CP-V   * * *'
*        LOAD WITH :J1.:SYS
*
#USERS   EQU      135
         DEF      #USERS
*
*        IF USERS VALUE IS CHANGED THE DATA TABLES MUST BE
*        RE-ARRANGED
*
         SYSTEM   UTS
*
         DEF      DIC,START
         DEF      LOADEM,PP
*
         REF      CAL1PSD
         REF      Y0008             TEST FILE OPEN BIT IN PLIST WORD 0
*
*
         CSECT    0
         BOUND    8
DIC      EQU      %                 BASE OF PATCH
         DATA     0,0,0,0,0,0,0,0,0,0  **PATCH AREA
         DATA     0,0,0,0,0,0,0,0,0,0  **PATCH AREA
*
CNTSTATS EQU      %
         DATA     MONSTART
         DATA     CAL11CNTD
         DATA     CAL12CNTD
         DATA     CAL13CNTD
         DATA     CAL14CNTD
         DATA     0
         DATA     CAL16CNTD
         DATA     CAL17CNTD
         DATA     CAL18CNTD
         DATA     CAL19CNTD
*
*
UNSTATS  EQU      %
         DATA     0
         DATA     CAL11UN
         DATA     CAL12UN
         DATA     CAL13UN
         DATA     CAL14UN
         DATA     0
         DATA     CAL16UN
         DATA     CAL17UN
         DATA     CAL18UN
         DATA     CAL19UN
*
*
CPUSTATS EQU      %
         DATA     MONCPU
         DATA     CAL11CPUD
         DATA     CAL12CPUD
         DATA     CAL13CPUD
         DATA     CAL14CPUD
         DATA     0
         DATA     CAL16CPUD
         DATA     CAL17CPUD
         DATA     CAL18CPUD
         DATA     CAL19CPUD
*
*
IOSTATS  EQU      %
         DATA     0
         DATA     CAL11IOD
         DATA     CAL12IOD
         DATA     CAL13IOD
         DATA     CAL14IOD
         DATA     0
         DATA     CAL16IOD
         DATA     CAL17IOD
         DATA     CAL18IOD
         DATA     CAL19IOD
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU               9
R10      EQU               10
R11      EQU               11
R12      EQU               12
R13      EQU               13
R14      EQU               14
R15      EQU               15
A00      EQU      1
B00      EQU      2
C00      EQU      3
C01      EQU      4
D00      EQU      5
E00      EQU      6
E01      EQU      7
F00      EQU      8                 F00 CPV
VERSION  EQU      F00               The latest(!) and greatest(??)
         REF      J:JIT,J:OVHTIM,JX:CMAP,JCMAP
         REF      S:PCORE,S:ACORE,S:CUN,UX:JIT,UH:JIT
         REF      TPACCESS,DCACCESS,DPACCESS
         REF      J:UTIME,J:PTIME,J:DELTAT,J:IDELTAT
         REF      CAL1P
         REF      Y004              MAP BIT
         REF      S:PNO             PROCESSOR NUMBER IN PAGE#1
         REF      M19,TSTACK
         REF      M17
         REF      ALTCP:
         REF      IOSPRTN           IN CALPROC
         SREF     NSCPU
         SREF     SX:SPP            SLAVE PRIV PAGE TABLE
         REF      X7F,M4,M3
         REF      CORED
         REF      JOVVPA            MON OVERLAY START ADDRES
         REF      M16
         REF      M15               DATA OF X'00007FFF'
         REF      UB:MF,UH:FLG
         REF      SCHED:
HOOKXLOC SET      SCHED:+X'5F'      (WD,0 X'37')
         DO1      VERSION=E01|VERSION=F00
HOOKXLOC SET      SCHED:+X'61'      (WD,0 X'37')
*
*
MP       SET      1                 MULTI-PROCESSING
*
*
*        FOR MONO-PROCESSOR SIGMA 7 VERSIONS YOU MUST CHANGE MP=0
*
*        IF YOU CHANGE THE HOOK IN SCHED YOU MUST CHANGE
*        THE USEAGE OF R14 AND THE EXPECTED DCB ADDRESS IN R6 IN
*        THE ROUTINES 'CALEND' , 'CALEND0' AND 'GETFUNC' .
*
         PAGE
*
*        GET HERE FROM 'TRAPEXIT' IN SCHED
*
CALEND   EQU      %
         LW,R14   RE:ENT
         BNEZ     %-1               RUNNING IN ONE COPY
         WD,0     X'37'             HOLD EVERYTING
         DO       MP=1              FOR MP VERSIONS
         LAS,R14  RE:ENT
         ELSE
         LI,R14   1
         XW,R14   RE:ENT
         FIN
         BNEZ     CALEND            DIDNT GET IT
         BAL,R14  GETUSER           GET CURRENT USER #
         AI,R14   CPUS+1
         EXU      *R14
         PAGE
*
*        PROCESS END OF CAL
*
CALEND0  EQU      %
         LW,R14   CPU:ENT           CHECK THIS PAGE RE:ENT
         BNEZ     %-1               THIS CPU BUSY NOW
         DO       MP=1              FOR MP VERSIONS
         LAS,R14  CPU:ENT           GRAB IT
         ELSE
         LI,R14   1
         XW,R14   CPU:ENT
         FIN
         BNEZ     CALEND0
         LI,R14   0
         STW,R14  RE:ENT            NOW GLOBAL RE-ENTRANT AGAIN
         LCI      8
         PSM,R3   MYSTK
         CLM,R4   USRANGE           COMPARE TO RANGE OF OUR TABLES
         BCS,9    CALEXIT           NO GO-> EXIT
         LB,R3    CALTYPE,R4        EXPECTING CAL FOR THIS USER
         BEZ      CALEXIT           NO
         CI,R3    1                 IS CAL1,1
         BNE      CALEND1           NOPE
         BAL,R8   GETFUNC           YUP-> CHANGE FPT CODE IF NECESSARY
CALEND1  EQU      %
         BAL,R7   UPDATE            UPDATE HISTORY TABLES NOW
CALEXIT  EQU      %
         LCI      8
         PLM,R3   MYSTK             RESTORE MON'S REGISTERS
         LI,R14   0
         STW,R14  CPU:ENT           CLEAR IT
RETURNX  NOP
         STCF     EXITX             STORE CC'S FROM REPLACED INST
         LPSD,0   EXITX             EXIT TO SCHED
*
CPU:ENT  DATA     0
*
         PAGE
*
*        INTERCEPT I/O TYPE CAL1,1'S HERE
*
GETFUNC  EQU      %
         LI,R3    #C1S
         LB,R5    FUNCTION,R4
         CB,R5    IOFPTS,R3         SEE IF WE WAN TO CHANGE CODE
         BE       GOTFUNC           YES-> CONVERT IT
         BDR,R3   %-2
*
*        NOT ONE WE WANT TO CHANGE THEN - DO IT ANYWAY
*
GOTFUNC  EQU      %
         STW,R3   FPT#              REMEMBER # IN CASE TP LINE
         LB,R10   IOFPTA,R3         GET CODE CHANGE VALUE (OR ZERO
         BAL,R9   GETMAP            CONVERT DCB TO REAL ADDRESS
         CLM,R6   CORE              IS OKAY VALUE
         BCS,9    *R8               NOPE-> GET OUT
         LI,R3   X'F'               ASN FIELD MASK
         AND,R3   0,6               PICK IT UP
         BEZ      *R8               BAD ONE
         CI,R3    X'4'              IS THIS 4 TP LINE
         BE       TPLINE            YES-> SPECIAL HANDLING
         CI,R3    X'3'              IS DEVICE
         BE       DEVICE            YES-> JUMP
         CI,R3    10                IS ANSI TAPE TYPE
         BG       *R8               BAD ONE
         BNE      %+2               NOPE
         LI,R3    2                 YES-> MAKE IT REGULAR TYPE
         AI,R3    X'2F'      ..FILE OR LABELED TAPE ASN
         B        SAVE:ARS          GET RWS FROM DCB
*
*        DEVICE I/O INTERCEPT HERE
*
DEVICE   EQU      %
         LI,R9    X'BF00'
         AND,R9   1,R6              GET DCB ASSIGNMENT FIELDS
         CI,R9    X'9000'           IS COC ASSIGNED...
         BE       COCDCB            YUP-> JUMP
         LI,R7    X'1FFFF'
         AND,R7   12,6
         BNEZ     SYMB              SYMBIONT DEVICE
         AI,R3    X'2F'
         B        COC1              GET ARS THEN
         PAGE
*
*
*
*30 READ FILE *35 WRIT FILE  *3A OPN FILE   *3F CLOSE FILE
*31 READ LBL  *36 WRIT LBL   *3B OPN LBL    *40 CLOSE LBL
*32 READ DEV  *37 WRIT DEV   *3C OPN DEV    *41 CLOSE DEV
*33 READ COC  *38 WRIT COC   *3D OPN COC    *42 CLOSE COC
*34 READ SYMB *39 WRIT SYMB  *3E OPN SYMB   *43 CLOSE SYMB
*
         PAGE
*
*        COC I/O HERE
*
COCDCB   EQU      %
         AI,R3    X'2F'+1
COC1     EQU      %
         B        SAVE:ARS
*
*        SYMBIONT I/O CAUGHT HERE
*
SYMB     EQU      %
         AI,R3    X'2F'+2
SAVE:ARS EQU      %
         LW,R7    4,R6           **A.R.S. FIELD IN DCB
         SLS,R7   -17
         AW,R3    R10
         CI,R10   X'80'
         BNE      %+2               IS OK
         LB,R3    FUNCTION,R4       USE ORIG FPT CODE FOOR OTHER KINDS
         STB,R3   FUNCTION,R4       STORE FPT CODE
*
* CHANGE FUNCTION TO REPRESENT ORGANIZATION IF FILE ASN
*
         LI,R5    X'F'
         AND,R5   0,R6              GET ASN FIELD AGAIN
         CI,R5    1                 IS FILE DCB
         BNE      NOT:FILE          NOPE
         LI,R5    X'70'             YES-> LETS FETCH ORG FIELD
         AND,R5   5,R6              FROM THIS DCB
         SLS,R5   -4                MOVE INTO POSITION
         LI,R10   X'49'             ASSUME READ 0 (CONSEC)
         CI,R3    X'30'             IS READ FPT CODE
         BE       RD:FILE           YEP
         LI,R10   X'4D'             LETS ASSUME WRITE FILE THEN
         CI,R3    X'35'             WELL
         BNE      NOT:FILE          NOPE-> LEAVE IT ALONE
RD:FILE  EQU      %
         AW,R10   R5                ADJUST FUNCTION BYTE
         STB,R10  FUNCTION,R4       REMEMBER IT
         LW,R3    R10               NOW ADJUST TO USE NEW FUNCTION
NOT:FILE EQU      %
         AWM,R7   CAL11MISCD,R3     ADD BYTE COUNT TO TOTAL BY FPT
         B        *R8               AND EXIT
*
IOFPTS   EQU      %
         DATA,1   0,16,17,20,21     READ/WRITE/OPEN/CLOSE FPT CODES
#C1S     EQU      BA(%)-BA(IOFPTS)-1
*
         BOUND    4
*
IOFPTA   DATA,1   X'80',0,5,10,15
         BOUND    4
         PAGE
*
*        SPECIAL CASE TP LINE HANDLING FOR READ-WRITE-OPEN-CLOSE
*
TPLINE   EQU      %
         LW,R3    FPT#              INDEX IDENTIFIES CAL TYPE
         LI,R10   0                 CLEAR R10 TO MERGE
         LB,R3    TPTYPES,R3        GET TP CODE
         B        SAVE:ARS          GET ARS AND MERGE W/COMMON PATH
*
FPT#     DATA     0
*
TPTYPES  DATA,1   0,;
                  X'45',;           TP LINE READ CAL
                  X'46',;           TP LINE WRIT CAL
                  X'47',;           TP LINE OPEN CAL
                  X'48'             TP LINE CLOS CAL
         BOUND    4
*
         PAGE
*
*        CAL START - ESTABLISH KIND OF CAL AND RECORD SAME
*
CALSTRT  EQU      %
         STCF     XITPSD            SAVE CC'S FROM CAL
         LCI      0
         STM,R0   CALREGS           SAVE USER'S REGISTERS
         LW,R6    *TRAPLOC          GET CAL TRAP IA
         AND,R6   M17               EXTRACT CAL INST ADDRS
         CLM,R6   OVERLAY           SEE IF CAL DONE FROM OVERLAY
         BCR,9    CALSTRT7          YES-> EXIT NOW
         LW,R4    *CUN              GET CURRENT USER #
         CLM,R4   USRANGE           FIT OUR TABLES
         BCS,9    CALSTRT7          NOPE-> GET OUT
         MTW,1    *CALCNT           BUMP CAL COUNTER
         BAL,R9   GETMAP            GET IA CHANGED
CALSTRT1 EQU      %
         BAL,R1   GETCONT           GET CONTENTS THERE
         LH,R3    R6                MOVE OPCODE
         BGEZ     CALSTRT2          NOT IND (*)
         BAL,R9   REMAP             CONVERT INDIRECT VALUE TO REAL
         BAL,R1   GETCONT           GET CONTENTS AT THAT ADDRS
CALSTRT2 EQU      %
         LW,R2    R3                MOVE OPCODE
         SLS,R2   -1                NORMALIZE INDEX FIELD
         AND,R2   M3                EXTRACT INDEX FIELD
         BEZ      CALSTRT3          CAL NOT INDEXED
         AW,R6    CALREGS,R2        GET VALUE FROM USER'S REGISTERS
CALSTRT3 EQU      %
         BAL,R9   REMAP             CONVERT PLIST ADDRS TO REAL
         CI,R3    X'2000'           CAL DONE BY EXU INST
         BANZ     CALSTRT1          YUP-> UNDO EXU INST
         SLS,R3   -4                POSITION CAL TYPE CODE
         AND,R3   M4                AND EXTRACT SAME
         CI,R3    9                 IS CAL1,9 TYPE OF CAL
         BE       CALSTRT8          YUP-> THEY ARE UNIQUE
         CLM,R3   CAL:RANGE         DONT SCREW UP HERE
         BCS,9    CALSTRT7          *** ERROR ***
         BAL,R1   GETCONT           GET PLIST WORD ZERO
         LB,R8    R6                GET FPT CODE
         AND,R8   X7F               DROP POSSIBLE IND BIT
         CI,R3    1                 IS CAL1,1
         BNE      CALSTRT5          NOPE
         CI,R8    X'14'             IS OPEN FPT CODE
         BNE      CALSTRT5          NOPE
         CW,R6    Y0008             IS TEST FILE OPEN BIT SET
         BAZ      CALSTRT5          NOPE
         LI,R8    X'44'             YUP-> CHANGE FPT CODE TO ACCOUNT FOR IT
CALSTRT5 EQU      %
         AI,R5    -JCMAP            MAKE R5 JIT BASE PAGE WA AGAIN
         CB,R8    CALSIZES,R3       COMPARE FPT CODE TO RANGE WE KNOW
         BG       CALSTRT7          TOO BIG-> THROW IT AWAY
CALSTRT6 EQU      %
         INT,R9   TPACCESS,R5       GET TAPE I/O ACCESS COUNT
         AW,R9    DCACCESS,R5       ADD RAD ACCESS
         AW,R9    DPACCESS,R5       AND PACK ACCESS
         STW,R9   STARTIO,R4        STORE STARTING IO COUNTS
         LW,R9    J:UTIME-J:JIT,R5  CALCULATE
         AW,R9    J:UTIME+1-J:JIT,R5 TIME
         AW,R9    J:PTIME-J:JIT,R5    FOR
         AW,R9    J:PTIME+1-J:JIT,R5   REPORT
         AW,R9    J:OVHTIM-J:JIT,R5     TIMES
         AW,R9    J:DELTAT-J:JIT,R5
         SW,R9    J:IDELTAT-J:JIT,R5
         STW,R9   STARTCPU,R4       STORE STARTING CPU TIME AWAY
         LW,R9    J:DELTAT          M:MON CPU TIME
         AW,R9    J:OVHTIM          SINCE CAL STARTED
         STW,R9   MONSTART,R4       INITIAL UNMAPPED CPU TICKS
         STB,R3   CALTYPE,R4        STORE CAL TYPE
         STB,R8   FUNCTION,R4       STORE FPT CODE
CALSTRT7 EQU      %
         LCI      0
         LM,R0    CALREGS
         LPSD,0   XITPSD            RETURN TO MONITOR CAL1 HANDLER
*
CALREGS  EQU      %
         DO1      16
         DATA     0
*
*
*        CAL1,9 HERE
*
CALSTRT8 EQU      %
         LW,R8    R6                MOVE FPT TYPE
         AND,R8   M4                EXTRACT FPT CODE
         B        CALSTRT5          MERGE
         PAGE
*
*        FETCH WORD AT ADDRESS IN R6
*
GETCONT  EQU      %
         AND,R6   M19
         CI,R6    15                ADDRS IN REGISTERS
         BG       %+2               NO
         AI,R6    CALREGS           POINT INTO CAL REGISTERS
         CLM,R6   CORE              CHECK TO SEE IF VALID ADDRS
         BCS,9    CALSTRT7          NO-> GET OUT QUICKLY
         LW,R6    0,R6              GET CONTENTS
         B        0,R1              AND RETURN
*
*
GETMAP   EQU      %
         LOAD,R5  UX:JIT,R4         GET JIT PAGE #
         SLS,R5   9                 INTO A WA
         AI,R5    JCMAP             POINT INTO JX:CMAP
REMAP    EQU      %
         AND,R6   M17
         CLM,R6   MAPLIM            ANYTHING TO DO
         BCS,9    *R9               NOPE
         SLD,R6   -9
         LOAD,R6  *R5,R6            GET REAL PAGE #
         SLD,R6   9
         B        *R9
         PAGE
*
*        UPDATE AMOUNT OF CPU TIME IT TOOK FOR THIS CAL
*
UPDATE   EQU      %
         LI,R5    0
         LB,R3    CALTYPE,R4        LOAD CAL TYPE
         STB,R5   CALTYPE,R4        AND CLEAR ENTRY
         LOAD,R5  UX:JIT,R4
         SLS,R5   9                 JIT PHYSICAL PAGE WA
         LB,R6    FUNCTION,R4       OK-GET FPT CODE FOR THIS CAL
         LW,R8    CNTSTATS,R3       GET POINTER TO FPT CODE COUNTER
         BEZ      %+2               NONE
         MTH,1    *R8,R6            COUNT TIMES WE SEE THIS FPT CODE
         INT,R9   TPACCESS,R5       GET TAPE I/O COUNTER FROM JIT
         AW,R9    DCACCESS,R5       ADD RAD ACCESS COUNTER
         AW,R9    DPACCESS,R5       ADD PAK ACCESS COUNTER
         SW,R9    STARTIO,R4        CALCULATE ELAPSED ACCESSES TODATE
         BLEZ     UPDATE1           NO CHANGE - JUMP
         LW,R8    IOSTATS,R3        GET POINTER TO I/O COUNT TABLE
         BEZ      UPDATE1           NO BUCKET
         AH,R9    *R8,R6            ADD PRIOR TOTAL
         STH,R9   *R8,R6            AND REPLACE
UPDATE1  EQU      %
         LW,R9    J:UTIME-J:JIT,R5  GET
         AW,R9    J:UTIME+1-J:JIT,R5 NEW
         AW,R9    J:PTIME-J:JIT,R5    CPU
         AW,R9    J:PTIME+1-J:JIT,R5   TIMES
         AW,R9    J:OVHTIM-J:JIT,R5     TOGETHER
         AW,R9    J:DELTAT-J:JIT,R5      FOR CAL
         SW,R9    J:IDELTAT-J:JIT,R5      ELAPSED TIME
         SW,R9    STARTCPU,R4       CALCULATE ELAPSED CPU TIME
         BLEZ     UPDATE2           **E R R O R **
         LW,R8    CPUSTATS,R3       POINTER TO CPU TIME BUCKET
         BEZ      UPDATE2           NONE-> RETURN
         AH,R9    *R8,R6            ADD PRIOR TOTAL
         STH,R9   *R8,R6            AND REPLACE
*
UPDATE2  EQU      %
         LW,R9    J:DELTAT          UNMAPPED
         AW,R9    J:OVHTIM          TICKERS
         SW,R9    MONSTART,R4       EQUALS ELAPSED UNMAPPED TICKS
         BLEZ     0,R7              NONE OR ERROR
         AWM,R9   MONCPU            BUMP TOTAL ELAPSED UNMAPPED TIME
         LW,R8    UNSTATS,R3        POINTER TO BUCKET
         BEZ      0,R7              NO TABLE
         AH,R9    *R8,R6            GET PRIOR TOTAL
         STH,R9   *R8,R6            AND REPLACE SAME
         B        0,R7              RETURN TO EXIT
*
ENDXPSD  XPSD,0   EXITX                      ***CAL END XPSD IN SCHECD
CUN      DATA     0
         PAGE
*
*        MAPPED INTERFACE CODE FOR CALMON
*
GOMAP    EQU      X'10'
GETUSER  EQU      X'14'
*
         BOUND    8
GOM      EQU      %
         :PSD     RES,(IA,GETUSER+1),(WK,0),MAP,MASTER,INH
*
GOM1     EQU      %
         XPSD,10  GOMAP
         STW,R14  GOMAP             SAVE UNMAPPED RETURN
         LW,R14   S:PNO             GET PROCESSOR #
         LPSD,0   GOMAP             AND RETURN
#GOMS    EQU      %-GOM
         PAGE
*
*        PSD'S AND STUFF
*
         BOUND    8
MAPLIM   DATA     X'8000'
         DATA     X'1FFFF'          MAP LIMITS FOR WA'S
*
*
OVERLAY  DATA     JOVVPA            MONITOR OVERLAY START ADDRESS
         DATA     J:JIT-1           LAST POSSIBLE OVERLAY ADDRS
*
CAL:RANGE DATA    1,9               RANGE OF CAL1'S WE DO HERE
*
USRANGE  DATA     1,#USERS          TABLE LENGTHS
*
*
CORE     DATA     0,X'1FFFF'        FILLED IN WITH CORED AT INIT
*
CALPSD   :PSD     (IA,CALSTRT),(WK,0),INH
EXITX    :PSD     (IA,HOOKXLOC+1),MAP,MASTER,INH
         :PSD     (IA,CALEND),(WK,0),INH
*
XITPSD   :PSD     (IA,CAL1P),(WK,1),MAP,MASTER,INH
*
#CAL11S  EQU      X'52'             NUMBER OF CAL1,1'S WE DO
#CAL12S  EQU      X'11'
#CAL13S  EQU      6
#CAL14S  EQU      7
#CAL16S  EQU      11
#CAL17S  EQU      X'E'
#CAL18S  EQU      X'1D'
#CAL19S  EQU      11
*
*
CALCNT   DATA     0
PNO      DATA     0
*
CALSIZES EQU      %
         DATA,1   0,;               0
                  #CAL11S,;         1
                  #CAL12S,;         2
                  #CAL13S,;         3
                  #CAL14S,;         4
                  0,;               5
                  #CAL16S,;         6
                  #CAL17S,;         7
                  #CAL18S,;         8
                  #CAL19S           9
         BOUND    4
*
CALCNTRS EQU      %-1
         DATA     MASTCPU           MASTER CPU
         DATA     SLVCPU
         DATA     SLVCPU
         DATA     SLVCPU
*
TRAPLOC  DATA     0                 POINTER TO CAL1 PSD LOC (VIRTUALLY)
         PAGE
*
*        THE STACK HERE MUST BE THE LAST THING IN THE PROCEDURE PAGE
*
         BOUND    8
MYSTK    EQU      %
         DATA     %+1
         DATA,2   64,0
         DO1      64
         DATA     0
*
         PAGE
*
*        DATA RECORD STARTS HERE
*
PPSIZ    EQU      %-DIC+1
*
         DATA     0,0,0
DP1      EQU      %
DBASE    SET      DP1               SET TO PAGE BNDRY...
*
DPDISP   CNAME
         PROC
LF       EQU      %
         LOCAL    LENGTH
LENGTH   SET      %-DBASE           SHOW DISP IN PAGE
         DISP     LENGTH
         PEND
*
*
*
*
*
CAL11CNTD EQU     %
         DPDISP
         DO1        #CAL11S
         DATA,2   0
         BOUND    4
*
CAL12CNTD EQU     %
         DPDISP
         DO1        #CAL12S
         DATA,2   0
         BOUND    4
*
CAL13CNTD EQU     %
         DPDISP
         DO1        #CAL13S
         DATA,2   0
         BOUND    4
*
CAL14CNTD EQU     %
         DPDISP
         DO1        #CAL14S
         DATA,2   0
         BOUND    4
*
CAL16CNTD EQU     %
         DPDISP
         DO1        #CAL16S
         DATA,2   0
         BOUND    4
*
CAL17CNTD EQU     %
         DPDISP
         DO1        #CAL17S
         DATA,2   0
         BOUND    4
*
CAL18CNTD EQU     %
         DPDISP
         DO1        #CAL18S
         DATA,2   0
         BOUND    4
*
CAL19CNTD EQU     %
         DPDISP
         DO1        #CAL19S
         DATA,2   0
         BOUND    4
*
*
*
*
CAL11CPUD EQU     %
         DPDISP
         DO1        #CAL11S
         DATA,2   0
*
CAL12CPUD EQU     %
         DPDISP
         DO1        #CAL12S
         DATA,2   0
*
CAL13CPUD EQU     %
         DPDISP
         DO1        #CAL13S
         DATA,2   0
*
CAL14CPUD EQU     %
         DPDISP
         DO1        #CAL14S
         DATA,2   0
*
CAL16CPUD EQU     %
         DPDISP
         DO1        #CAL16S
         DATA,2   0
*
CAL17CPUD EQU     %
         DPDISP
         DO1        #CAL17S
         DATA,2   0
*
CAL18CPUD EQU     %
         DPDISP
         DO1        #CAL18S
         DATA,2   0
*
CAL19CPUD EQU     %
         DPDISP
         DO1        #CAL19S
         DATA,2   0
*
*
*
*
CAL11IOD EQU      %
         DPDISP
         DO1        #CAL11S
         DATA,2   0
         BOUND    4
*
CAL12IOD EQU      %
         DPDISP
         DO1        #CAL12S
         DATA,2   0
         BOUND    4
*
CAL13IOD EQU      %
         DPDISP
         DO1        #CAL13S
         DATA,2   0
         BOUND    4
*
CAL14IOD EQU      %
         DPDISP
         DO1        #CAL14S
         DATA,2   0
         BOUND    4
*
CAL16IOD EQU      %
         DPDISP
         DO1        #CAL16S
         DATA,2   0
         BOUND    4
*
CAL17IOD EQU      %
         DPDISP
         DO1        #CAL17S
         DATA,2   0
         BOUND    4
*
CAL18IOD EQU      %
         DPDISP
         DO1        #CAL18S
         DATA,2   0
         BOUND    4
*
CAL19IOD EQU      %
         DPDISP
         DO1        #CAL19S
         DATA,2   0
         BOUND    4
*
*
*        UNMAPPED TICKS PER CAL TYPE
*
*
CAL11UN  EQU      %
         DPDISP
         DO1      #CAL11S
         DATA,2   0
         BOUND    4
*
CAL12UN  EQU      %
         DPDISP
         DO1      #CAL12S
         DATA,2   0
         BOUND    4
*
CAL13UN  EQU      %
         DPDISP
         DO1      #CAL13S
         DATA,2   0
         BOUND    4
*
CAL14UN  EQU      %
         DPDISP
         DO1      #CAL14S
         DATA,2   0
         BOUND    4
*
CAL16UN  EQU      %
         DPDISP
         DO1      #CAL16S
         DATA,2   0
         BOUND    4
*
CAL17UN  EQU      %
         DPDISP
         DO1      #CAL17S
         DATA,2   0
         BOUND    4
*
CAL18UN  EQU      %
         DPDISP
         DO1      #CAL18S
         DATA,2   0
         BOUND    4
*
CAL19UN  EQU      %
         DPDISP
         DO1      #CAL19S
         DATA,2   0
         BOUND    4
*
*
*
*
*
*
CAL11MISCD EQU    %
         DPDISP
         DO1      1+#CAL11S
         DATA     0
*
DP1SIZ   EQU      %-DP1+1
*
         DATA     0,0,0
         PAGE
*
*        DATA PAGE # 2 STARTS HERE
*
DP2      EQU      %
*        COUNTERS
*
DP2DISP  CNAME
         PROC
LF       EQU      %
         LOCAL    LENGTH
LENGTH   SET      %-DP2+(512)       SHOW DISP IN PAGE
         DISP     LENGTH
         PEND
*
*
*        M:MON ELAPSED DATA
*
*
*
*
CALTYPE  EQU      %
         DP2DISP
         DO1      #USERS+1
         DATA,1   0
         BOUND    4
*
FUNCTION  EQU     %
         DP2DISP
         DO1      #USERS+1
         DATA,1   0
         BOUND    4
*
STARTCPU  EQU     %
         DP2DISP
         DO1      #USERS+1
         DATA     0
*
STARTIO  EQU      %
         DP2DISP
         DO1      #USERS+1
         DATA     0
*
         BOUND    4
*
*
*        STARTING UNMAPPED TIME INDEXED BY USER #
*
MONSTART EQU      %
         DO1      #USERS+1
         DATA     0
         DP2DISP
MONCPU   DATA     0
         DP2DISP
MASTCPU  DATA     0
         DP2DISP
SLVCPU   DATA     0
*
RE:ENT   DATA     0
*
*
CPUS     EQU      %
         B        CALEND0
         B        CALEND0
         B        CALEND0
         B        CALEND0
*
*
*
DP2SIZ   EQU      %-DP2+1
*
*        DONE WITH COUNTER TABLES
*
*
*
PATSIZ   EQU      %-DIC+1           TOTAL LENGTH OF PATCH
         PAGE
*
         CSECT    1                 REVERT TO NEW SECTION
PP       EQU      %                 START OF PURE PROCEDURE
         DATA     0
TRAPIA   EQU      %
         DATA     TRAPLOC-DIC+PP0
         DATA     TRAPLOC-DIC+PP1
         DATA     TRAPLOC-DIC+PP2
         DATA     TRAPLOC-DIC+PP3
*
*
CUNLOC   EQU      %
         DATA     CUN-DIC+PP0
         DATA     CUN-DIC+PP1
         DATA     CUN-DIC+PP2
         DATA     CUN-DIC+PP3
*
PNOLOC   EQU      %
         DATA     PNO-DIC+PP0
         DATA     PNO-DIC+PP1
         DATA     PNO-DIC+PP2
         DATA     PNO-DIC+PP3
*
*
VXPSD    EQU      %
         DATA     CALPSD-DIC+PP0
         DATA     CALPSD-DIC+PP1
         DATA     CALPSD-DIC+PP2
         DATA     CALPSD-DIC+PP3
*
*
CALOC    EQU      %
         DATA     CALCNT-DIC+PP0
         DATA     CALCNT-DIC+PP1
         DATA     CALCNT-DIC+PP2
         DATA     CALCNT-DIC+PP3
*
HOOK2    EQU      %
         DATA     RETURNX-DIC+PP0
         DATA     RETURNX-DIC+PP1
         DATA     RETURNX-DIC+PP2
         DATA     RETURNX-DIC+PP3
*
         PAGE
         SYSTEM   BPM
         REF      M:LL,M:LO
         REF      SITEID
         REF      T:FPP,T:GPP
         REF      QUEUE,QUEUE1,NEWQ
         REF      SMUIS
*
*
*
*        VIRTUAL PAGE ASSIGNMENTS
*
PP0      EQU      X'10000'          PATCH FOR MASTER CPU
PP1      EQU      PP0+512           PATCH FOR SLAVE CPU#1
PP2      EQU      PP1+512           PATCH FOR SLAVE CPU#2
PP3      EQU      PP2+512           PATCH FOR SLAVE CPU#3
DPG1     EQU      PP3+512           DATA TABLES VIRTUAL LOC
DPG2     EQU      DPG1+512          DATA TABLES VIRTUAL LOC
*
SAMPLE   EQU      05                SAMPLE SIZE (IN MINUTES)
         PAGE
*
*        HOOK UP AND START OFF COLLECTING STUFF
*
START    EQU      %
         CAL1,6   SYSFPT            OK-> GET INTO MASTER MODE
         BCS,8    ERRORX            PRIV<C0
         LW,R0    HOOKXLOC          GET LOC IN SCHED
         CW,R0    =X'6D000037'      HAD BEST BE DISABLE
         BNE      NEWMON            E R R O R   BETTER BAIL OUT
         CI,8     QUEUE
         BNE      NEWMON
         CI,9     QUEUE1
         BNE      NEWMON
         CI,10    NEWQ
         BNE      NEWMON
         LI,8     SMUIS             MAXIMUM USERS IN SYSTEM
         CI,8     #USERS            MAXIMUM USERS I CAN HANDLE
         BGE      BAILOUT           BAIL OUT OR CRASH
*
*        IF SIGMA 7 CPU GET RID OF LOAD-AND-SET (LAS) INSTRUCTIONS
*
         LW,R1    X'2B'             GET CPU TYPE WORD
         CI,R1    X'40'             IS SIGMA 7 CPU
         BAZ      NOTE7             NOPE
         CI,R1    X'80'             MIGHT BE 560
         BANZ     NOTE7             IS 560
         CI,R1    X'2000'           MIGHT BE A FUNNY SIGMA 7
         BANZ     NOTE7             IS IT A MULTIPROCESSOR SYSTEM?
         LCI      3                 NO-> MUST CLEAR LAS INST
         LM,R0    SET1              GET REPLACED INST'S
         STM,R0   CALEND
*
         LCI      3
         LM,R0    SET2
         STM,R0   CALEND0
*
NOTE7    EQU      %                 COME HERE IF SIGMA-9 OR X-560
*
         LW,R5    CORED
         AI,R5    -1                R5 = # OF WORDS IN CORE
         STW,R5   CORE+1            STORE IN CLM PAIR IN PATCH CODE
         LI,R5    CAL1PSD
         AND,R5   =X'7FE00'
         STW,R5   SPP               SAVE BASE PAGE WA OF CAL1PSD LOC
*
*        ABOVE IS FOR MASTER CPU BASE PAGE
*
         LI,R3    NSCPU             # OF SLAVE CPU'S IN SYSTEM
         BEZ      NOTMP             NOT MP SYSTEM
         LI,R3    1                 START WITH FIRST SLAVE
GET:CPUADR EQU    %
         LOAD,R4  SX:SPP,R3         GET SLAVE CPU PAGE #
         SLS,R4   9
         STW,R4   SPP,R3            SAVE FOR LATER USE
         AI,R3    1
         CI,R3    NSCPU+1
         BL       GET:CPUADR        NOT DONE YET
NOTMP    EQU      %
         LI,R2    0
         LI,R3    1
         MTB,1    CPUCNT,R3         MARK ALL SLAVE CPU'S IN SYSTEM
         AD,R2    DB1
         CI,R2    NSCPU+1
         BL       %-3
*
*        GET PHYSICAL PAGES
*
         LI,R4    #RELO
PGLOOP   STW,R4   PAGEX
         LI,R3    0
         MTB,0    CPUCNT,R4         NEED A PAGE HERE
         BEZ      PGLOOP1           NOPE
         BAL,R11  GPP               YES
PGLOOP1  LW,R4    PAGEX
         STW,R3   PAGES,R4          STORE PAGE #
         SLS,R3   9
         STW,R3   NEWLOC,R4         STORE WORD ADDRESS
         BDR,R4   PGLOOP
*
*        MAP ONTO SLAVE CPU PRIVATE PAGES
*
         LI,R3    0
SLAVECVM LW,R2    SPP,R3            GET PHYSICAL PAGE WA
         BEZ      SLAVECV1          NONE
         M:GP     1
         BCS,8    NOCVM
         STW,R9   SPPVIRT,R3        SAVE NEW WA
         M:FVP    *R9               FREE IT
         M:CVM    *R2,*R9           MAP ONTO SLAVE PAGE
         BCS,8    NOCVM             CANT DO IT
SLAVECV1 AI,R3    1
         CI,R3    NSCPU+1
         BL       SLAVECVM          KEEP GOING THEN
*
*        MAP ONTO ALL PHYSICAL PAGES
*
         LI,R3    0
CVMLOP   LW,R2    NEWLOC,R3         GET PHYSICAL PAGE WA
         BEZ      CVMLOP1           NONE THERE
         LW,R4    NEWVPLOC,R3       GET VIRTUAL ADDRS TO USE
         M:CVM    *R2,*R4           MAP ONTO
         BCS,8    NOCVM             ERROR
CVMLOP1  EQU      %
         AI,R3    1
         CI,R3    #RELO
         BL       CVMLOP            GO ON
*
         PAGE
*
*        ALL POINTERS COLLECTED - RELOAD PROCEDURE IN NEW PAGES
*
         BAL,R7   SLAVE             DO IT IN SLAVE MODE THO
         LI,R1    0
LOADEM   EQU      %
         LW,R4    SIZES,R1          GET LENGTH OF AREA
         LW,R10   STARTS,R1
         LW,R12   NEWVPLOC,R1       PLACE IT GOES TO
         BAL,R11  RELOAD            RELOAD THAT AREA
         CI,R1    4                 UP TO DATA PAGES YET
         BG       %+3               NOT YET
         LD,R12   DB1               GET SUPPRESSOR
         STD,R12  PAIRS,R1          CLEAR THIS CPU OUT
         AI,R1    1
         CI,R1    #RELO
         BL       LOADEM            GO ON
         CAL1,6   SYSFPT            RETURN TO MASTER MODE
         LPSD,0   STOREPSD
         PAGE
*
*        RELOAD PATCH AS THO IT WERE LOADED IN THE PAGES WE GOT
*
RELOAD   EQU      %
         LW,R6    *R10              GET WORD
         BEZ      RELOAD2           NOTHING TO DO TO THOSE
         LW,R5    R6                COPY TO R5
         LH,R8    R5                HOLD OPCODE IN R8
         AND,R5  =X'1FFFF'          GRAB 17 BITS
         LI,R3    0
RELOAD0  EQU      %
         CLM,R5   PAIRS,R3          FIND MATCHING PAIR
         BCR,9    RELOAD1           GOTCHA
         AI,R3    1
         CI,R3    #RELO+1
         BL       RELOAD0           GO ON
         B        RELOAD2           NOT ONE OF OURS
RELOAD1  EQU      %
         SW,R5    STARTS,R3         CALCULATE ITS PAGE DISP
         BLZ      RELOAD2           ERROR
         AW,R5    NEWLOC,R3         ADD NEW START ADDRESS
         SLS,R8   16                PUT OPCODE IN PLACE
         AND,R8   =X'FFFE0000'      SCREEN ANY CRAP
         OR,R5    R8                RE-INSERT OPCODE/REG/INDEX REG
         LW,R6    R5                MOVE RELOADED INST
RELOAD2  EQU      %
         MTW,0    PAGES,R1          NEED TO MOVE THIS ONE
         BEZ      RELOAD3           NOPE--> JUMP
         STW,R6   *R12              MOVE TO PATCH AREA
         AI,R12   1                 NEXT LOC
RELOAD3  EQU      %
         AND,R6   =X'1FFFF'         STRIP OUT RELOADED INST AGAIN
         CLM,R6   AREALIM           CHECK WE DIDN'T SCREW UP
         BCR,9    BADDIC            *** ERROR ***
         AI,R10   1                 NEXT LOC
         BDR,R4   RELOAD            FINISH UP
         B        *R11              AND RETURN
         PAGE
*
*        FINISH UP THE RELOAD
*
STORE    EQU      %
         LCI      #GOMS
         LM,R0    GOM
         STM,R0   GOMAP             STORE MAPPED CODE IN LOC X'10' THRU X'17'
         LI,R2    0
         LI,R3    0
STORE0   EQU      %
         LW,R6    HOOK2,R3          LOC IN EACH CPU PAGE
         LW,R1    HOOKXLOC          CONTENTS IN MONITOR
         STW,R1   *R6               STORE REPLACED INST IN PATCH
         LW,R5    CPUS,R3           GET BRANCH VECTOR ADDRS
         AND,R5   M17
         SW,R5    STARTS,R3         BASE PAGE TAKEN OUT
         AW,R5    NEWLOC,R3         ADD IN NEW UNMAPPED ADDRS
         LI,R6    X'68'
         STB,R6   R5                MAKE IT A BRANCH
         STW,R5   CPUS-DP2+DPG2,R3
         LI,R5    S:CUN
         AND,R5   =X'1FF'           PAGE DISP VALUE
         AW,R5    SPP-1,R3          PHYSICAL ADDRESS OF IT
         LW,R0    CUNLOC,R3         PLACE IT GOES
         STW,R5   *R0               PLANT IT IN ONE COPY
         LI,R5    S:PNO             PROCESSOR # CELL
         AND,R5   =X'1FF'           PAGE DISP
         AW,R5    SPP-1,R3          R5 = UNMAPPED ADDRESS OF S:PNO
         LW,R0    PNOLOC,R3         GET MAPPED LOC FOR IT
         STW,R5   *R0               STORE UNMAPPED ADDRESS FOR FRONT-END
*
         AD,R2    DB1               AND DO EACH CPU
         CI,R2    NSCPU+1           TILL END
         BL       STORE0            ..
         LW,R5    ENDXPSD-DIC+PP0   GET XPSD
         STW,R5   HOOKXLOC          AND STUFF INTO SCHED
         LI,R2    0
         LI,R3    1
STORE2   EQU      %
         LI,R4    CAL1PSD
         AND,R4   =X'1FF'           PAGE DISP OF CAL1 RECEIVER
         AW,R4    SPP-1,R3          R4=PHYSICAL WA OF IT
         LW,R0    TRAPIA,R3
         STW,R4   *R0
         LI,R4    CAL1PSD+2
         AND,R4   =X'1FF'
         AW,R4    SPPVIRT,R3        GET ITS VIRTUAL (FIR US) LOC
         LD,R12   *R4               GET (OLD) NEW PSD FOR CAL1'S
         LW,R0    VXPSD,R3
         LD,R10   *R0               GET OUR NEW PSD DBL-WORD
         STD,R10  *R4               IN PLACE
         STD,R12  SAVXPSD,R3        SAVE THEIRS
         LW,R0    CALOC,R3
         LW,R4    CALCNTRS-DIC+PP0,R3   **GET RELOADED POINTER
         STW,R4   *R0                  ** AND DROP INTO PLACE
         AD,R2    DB1
         CI,R2    NSCPU+1
         BL       STORE2            FINISH UP
STORE3   EQU      %
         LCI      2
         LM,0     SITEID
         STM,0    SITELOC
         BAL,R7   SLAVE             RETURN TO SLAVE MODE
         M:INT    BREAK
         M:XCON   DESTRUCT
         M:TIME   PATCHMSG+3,TMS
         LW,1     9
         CVA,1    MS                MILLISECS
         STW,1    INITTIME
         LI,R15   PATCHMSG          MSG TEXTC ADDRESS
         LI,R7    PRINT             ASSUME ONLINE FIRST
         LC       J:JIT             TEST ASSUMPTION
         BCS,8    %+2               DATS TRUE
         LI,R7    TYPE
         CAL1,2   *R7               TYPE OR PRINT IT
         INT,1    8                 JULIAN DATE
         LI,2     BA(VP+1)+3
         BAL,11   BIN2BCD
         LB,1     9                 HOUR
         LI,2     BA(VP+1)+6
         BAL,11   BIN2BCD
         LI,1     1
         LB,1     9,1               MINUTE
         LI,2     BA(VP+1)+9
         BAL,11   BIN2BCD
,,VP     M:OPEN   M:LO,(FILE,'000:00:00'),(EXPIRE,7),OUT,SAVE
         M:CLOSE  M:LO,SAVE
         LI,R15   VP+1              TEXTC ADDRESS
         LI,R7    PRINT
         LC       J:JIT
         BCS,8    %+2               WE'RE RUNNING ONLINE
         LI,R7    TYPE
         CAL1,2   *R7               TYPE OR PRINT
         PAGE
*
*        SLEEP WHILE DATA IS BEING COLLECTED
*
SLEEP    EQU      %
         M:WAIT   SAMPLE*50         SAMPLE
OPEN     EQU      %
*
*        BLOCK CAL COLLECTOR TILL DONE HERE
*
         M:OPEN   M:LO,INOUT,(ABN,BUSY)
         M:PFIL   M:LO,EOF
         M:TIME   TIMEDATE,TMS
         STW,R9   CUR:TIME          SAVE CURRENT TMS
         CAL1,6   SYSFPT            GO BACK TO MASTER CPU
         WD,0     X'37'             AND HOLD EVERYTHING UP HERE
         LD,R0    BLOCKER
         STD,R0   USRANGE-DIC+PP0   PREVENT CAL COLLECTOR FOR TIME BEING
         LCI      2
         LM,R0    DBS               FIRST PAIR
         STM,R0   FROMWA            SETUP
         LI,R0    32                32 PASSES
         STW,R0   MOVECNT#          SETUP
MOVELOOP EQU      %
         LCI      0
         LM,R0    *FROMWA           GET INFO
         STM,R0   *TOWA             INTO OUR BUFFERS
         LCI      0
         LM,R0    ZEROES            AND THEN SUPPRESS
         STM,R0   *FROMWA           DAATA AGAIN
         LI,R0    16
         AWM,R0   FROMWA
         AWM,R0   TOWA
         MTW,-1   MOVECNT#
         BGZ      MOVELOOP          KEEP GOING
*
*        MOVE DATA PAGE TWO NOW
*
         LCI      2
         LM,R0    DBS2
         STM,R0   FROMWA            SETUP
         LI,R0    32
         STW,R0   MOVECNT#
MOVELOOP2 EQU     %
         LCI      0
         LM,R0    *FROMWA
         STM,R0   *TOWA
         LI,R0    16
         AWM,R0   FROMWA
         AWM,R0   TOWA
         MTW,-1   MOVECNT#
         BGZ      MOVELOOP2         RECORDS LEFT YET
*
*        ALL DATA IS NOW IN THE OUTPUT BUFFER
*
*
*        CLEAR COUNTERS THAT MAY OVERFLOW
*
         LI,R9    0
         STW,R9   MONCPU-DP2+DPG2   CLEAR UNMAPPED CPU TIME
         STW,R9   MASTCPU-DP2+DPG2
         STW,R9   SLVCPU-DP2+DPG2
         LW,R9    CUR:TIME          GET CURRENT TIME AGAIN
         CVA,9    MS
         LW,11    9
         SW,9     INITTIME
         BLZ      MIDNIGHT          **HIT A NEW DAY
         AWM,9    INITTIME          INCREMENT ELAPSED TIME
STIME    EQU      %
         STW,9    TIME
         LD,R0    UNBLOCKER
         STD,R0   USRANGE-DIC+PP0   ENABLE THE CAL COLLECTOR AGAIN
         BAL,R7   SLAVE             BACK TO SLAVE MODE
         M:WRITE  M:LO,(BUF,TIMEDATE),(SIZE,STAMPSIZE*4)
         M:WRITE  M:LO,(BUF,WBUF),(SIZE,1024*4)
         M:CLOSE  M:LO
         MTW,-1   RECORDS           DECREMENT RECORD COUNTER
         BLZ      DESTRUCT          DONE AFTER 12 HOURS
         B        SLEEP
         BOUND    8
BLOCKER  DATA     0,0               USER # LIMITS TO BLOCK CALMON
UNBLOCKER DATA    1,#USERS
BUSY     EQU      %
         M:WAIT   1
         B        OPEN
         PAGE
*
*        RECORDING INTO A NEW DAY-> ADJUST TICKERS
*
MIDNIGHT EQU      %
         LW,R9    MNTMS             GET MIL TICKS IN ONE DAY
         SW,R9    INITTIME          CALCULATE ELAPSED TICKS TO END
         LW,R1    CUR:TIME          GET LATEST TMS
         CVA,R1   MS                CONVERT TO MILLISECONDS
         STW,R1   INITTIME          RESET THIS TICKER
         CI,R9    0                 OK-> DID WE ERROR HERE
         BLZ      SLEEP             YUP-> THROW AWAY THIS RECORD
         B        STIME             START OFF AGAIN
MNTMS    DATA     24*60*60*1000     MILLISECONDS IN 24 HOURS
*
ZEROES   EQU      %
         DO1      16
         DATA     0
         PAGE
*
*
         BOUND    8
*
AREALIM  DATA     X'A000',DEPATCHMSG+512
*
*
DBS      DATA     DPG1              WA OF DATA PAGE ONE
         DATA     WBUF              WA OF BUFFER
*
DBS2     DATA     DPG2
         DATA     WBUF2
*
DB1      DATA     1,1
SIZES    EQU      %
         DATA     PPSIZ,PPSIZ,PPSIZ,PPSIZ,DP1SIZ,DP2SIZ
#RELO    EQU      %-SIZES-1
*
STARTS   EQU      %
         DATA     DIC,DIC,DIC,DIC,DP1,DP2
*
NEWVPLOC EQU      %
         DATA     PP0               0
         DATA     PP1               1
         DATA     PP2               2
         DATA     PP3               3
         DATA     DPG1              4
         DATA     DPG2              5
*
         PAGE
*
*        BREAK RECEIVER (BRK CAUSES SELF-DESTRUCT)
*
BREAK    EQU      %
         LI,2     DESTRUCT
         LI,3     X'1FFFF'
         STS,2    0,1
         CAL1,9   5                 M:TRTN BACK TO ABORT
         PAGE
*
*        NON SIGMA-9 OR 560 INSTRUCTIONS
*
SET1     EQU      %
         LI,R14   1
         XW,R14   RE:ENT
         CI,R14   0
*
SET2     EQU      %
         LI,R14   1
         XW,R14   CPU:ENT
         CI,R14   0
*
         PAGE
*
*        SELF-DESTRUCT AND EXIT
*
DESTRUCT EQU      %
         CAL1,6   SYSFPT
         LPSD,0   RESTOREPSD
RESTORE  EQU      %
         LI,R2    0
         LI,R3    1
RESTORE1 EQU      %
         LI,R4    CAL1PSD+2
         AND,R4   =X'1FF'           DISP OF CAL1PSD (NEW SLOT)
         AW,R4    SPPVIRT,R3        ADD OUR CVM WINDOWN ADDRS
         LD,R6    SAVXPSD,R3
         BEZ      %+2               NONE
         STD,R6   *R4               PUT BACK INTO PLACE
NORESTO  EQU      %
         AD,R2    DB1
         CI,R2    NSCPU+1
         BL       RESTORE1
*
         LW,R5    RETURNX-DIC+PP0
         STW,R5   HOOKXLOC          RESTORE SCHED INST ALSO
         LI,R4    #RELO
RESTORE2 EQU      %
         STW,R4   PAGEX             SAVE LOOP
         LW,R3    PAGES,R4          GET PHYSICAL PAGE #
         BLEZ     RESTORE3          NONE OR ERROR
         BAL,R2   T:FPP             RELEASE IT
         MTW,1    S:PCORE
         MTW,1    S:ACORE           BUMP CORE COUNTERS BACK UP
RESTORE3 EQU      %
         LW,R4    PAGEX
         AI,R4    -1
         BGZ      RESTORE2          DO TILL DONE
*
         M:TIME   DEPATCHMSG+3
         LI,R15   DEPATCHMSG
         LI,R7    PRINT
         LC       J:JIT
         BCS,8    %+2               WE'RE ONLINE
         LI,R7    TYPE              WE'RE BATCH/GHOST MODE
         CAL1,2   *R7
         M:XCON   0
         CAL1,9   1
         PAGE
*
*        CONVERSION TO BCD
*
BIN2BCD  EQU      %
         LI,0     0
         DW,0     =10
         AI,0     '0'
         STB,0    0,2
         AI,1     0
         BEZ      *11
         BDR,2    BIN2BCD
         B        *R11
         PAGE
*
*        GET PHYSICAL PAGE
*
GPP      EQU      %
         LI,15    100
         BAL,2    T:GPP             GET PHYSICAL PAGE
         AI,3     0                 GOT ONE
         BEZ      NOPAGE
         CI,3     255               USABLE PAGE
         BG       BADPAGE
         MTW,-1   S:PCORE
         MTW,-1   S:ACORE
         B        *11
BADPAGE  EQU      %
         BAL,2    T:FPP             GIVE IT BACK
NOPAGE   EQU      %
         M:WAIT   1
         BDR,15   GPP+1
         LI,R15   NOPGMSG
         CAL1,2   PRINT
EXIT     EQU      %
         CAL1,9   1
*
SYSFPT   GEN,8,24 8,0
*
         PAGE
*
*        MADE AN ERROR RELOADING THE PATCH AT NEW ADDRESS
*
BADDIC   LI,R15   DICMSG
         B        ERRMSG
NEWMON   LI,R15   MONMSG
         B        ERRMSG
NOCVM    LI,R15   CVMSG
         B        ERRMSG
ERRORX   LI,R15   PRVMSG
         B        ERRMSG
BAILOUT  LI,R15   TOMUC
ERRMSG   CAL1,2   PRINT
         CAL1,9   3
HEX      TEXT     '0123456789ABCDEF'
DICMSG   TEXTC    '**INTERNAL ERROR IN RELOADING'
MONMSG   TEXTC    '**LOADED W/WRONG MONSTK'
NOPGMSG  TEXTC    '**CANT GET PAGE IN 1ST 128K'
PRVMSG   TEXTC    '**YOUR PRIV<C0'
CVMSG    TEXTC    '**ERROR IN REMAP'
TOMUC    TEXTC    '**SMUIS>MYTABLE SIZES'
*
PRINT    GEN,8,24 1,M:LL
         PZE      *0
         PZE      *15               MSG ADDRESS IN R15
*
TYPE     DATA     0                 M:MSG FORM
         PZE      *0
         PZE      *R15              TEXTC ADDRS IN R15
*
         PAGE
RESTOREPSD :PSD   (IA,RESTORE),(WK,0),MAP,MASTER,INH
STOREPSD :PSD     (IA,STORE),(WK,0),MAP,MASTER,INH
*
SLAVPSD  :PSD     (IA,SLAVE1),MAP,(WK,1),SLAVE
         PAGE
*
*        RETURN TO SLAVE MODE
*
SLAVE    EQU      %
         LPSD,0   SLAVPSD
SLAVE1   B        0,R7              RETURN TO CALLER
*
         PAGE
*
*        CONVERSION TO MILLISECONDS
*
MS       RES      0
         DATA     0
         DATA     0
         DATA     60*60*1000*32
         DATA     60*60*1000*16
         DATA     60*60*1000*8
         DATA     60*60*1000*4
         DATA     60*60*1000*2
         DATA     60*60*1000
         DATA     0
         DATA     60*1000*64
         DATA     60*1000*32
         DATA     60*1000*16
         DATA     60*1000*8
         DATA     60*1000*4
         DATA     60*1000*2
         DATA     60*1000
         DATA     0
         DATA     1000*64
         DATA     1000*32
         DATA     1000*16
         DATA     1000*8
         DATA     1000*4
         DATA     1000*2
         DATA     1000
         DATA     0
         DATA     0
         DATA     0
         DATA     32
         DATA     16
         DATA     8
         DATA     4
         DATA     2
         PAGE
*
*        DATA AREA
*
         CSECT    0
*
RECORDS  DATA     (60/SAMPLE)*12    ** 12 HOURS OF RECORDING AND EXIT
*
         BOUND    8
PAIRS    EQU      %
         DATA     DIC,DIC+PPSIZ
         DATA     DIC,DIC+PPSIZ
         DATA     DIC,DIC+PPSIZ
         DATA     DIC,DIC+PPSIZ
         DATA     DP1,DP1+DP1SIZ
         DATA     DP2,DP2+DP2SIZ
*
PAGEX    DATA     0
*
PAGES    EQU      %
         DATA     0,0,0,0,0,0,0,0
*
NEWLOC   EQU      %
         DATA     0,0,0,0,0,0,0,0
*
         BOUND    8
SAVXPSD  EQU      %
         DATA     0,0               ZERO POSITION
         DATA     0,0
         DATA     0,0
         DATA     0,0
         DATA     0,0
*
SPP      EQU      %
         DATA     512,0,0,0
*
SPPVIRT  EQU      %
         DATA     0,0,0,0
*
CPUCNT   DATA     X'00990000'
         DATA     X'00010200'
*
TIMEMSG  EQU      %
         DATA,1   TCNT,'R','E','C'
         TEXT     'ORD '
         TEXT     'WRIT'
         TEXT     'TEN@'
TIMEDATE TEXT     '1234567812345678'
TCNT     EQU      BA(%)-BA(TIMEMSG)-1
*
TIME     DATA     1
SITELOC   DATA    0,0
STAMPSIZE EQU     %-TIMEDATE
INITTIME DATA     0
CUR:TIME DATA     0
         BOUND    8
WBUF     RES      512
*
WBUF2    RES      512
*
PATCHMSG TEXTC    'PATCHED IN@24:03 JAN 01,''77'
DEPATCHMSG TEXTC  'REMOVED @: 24:00 JAN 01,''79 '
*
*        BUMP CELLS FOR BUFFER MOVES
*
FROMWA   DATA     0
TOWA     DATA     0
*
MOVECNT# DATA     16
         END      START
