*        704758   SIGMA 5/7         BPM M:CALPROC
S69PROC  SET      1
MONPROC  SET      1
         PCC      0
         SYSTEM   UTS
         DEF      CALPROC
CALPROC  EQU      %
*                                  CALPROC
         PAGE
*
*                          PROGRAMMER  -  DOUGLAS W. HEYING
*
         SREF     C:CAL             SREF IN CASE NO PERF MONITOR
         PAGE
*                 SYMBOLIC REGISTER DEFINITIONS.
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D3       EQU      14
D4       EQU      15
R11      EQU      11
R12      EQU      12
R13      EQU      13
         PAGE
*                 PARAMETERS TO DEFINE BATCH MONITOR.
*                 DEFS AND REFS FOR OBJECT MODULE.
*
*                 DEFS.
         DEF      CAL1P11
         DEF      S:BUFMCW
*
*                 DEFS AND REFS FOR OBJECT MODULE.
*
*                 DEFS.
*
*                 REFS FOR CAL ROUTINES (MONITOR SERVICES)
         REF      M:OC,M:UC,M:XX
         REF      J:JIT
         REF      CAL11N7
         REF      TXTCFU
AGER     EQU      9                 DCB W9 HAS CAL AGE, BUFF ADDRESSES.
         REF      Y002
         REF      M4
         REF      OPNSEG,CLSSEG,LBLTSEG
         REF      IOSDEV
         REF      MSROCTY,MSRTYPR
         REF      J:DCBLINK
                  REF      PFIL#,PRECORD#,REW#,WEOF#
         REF      IOCHEK,MSRKEY#,MERC
         REF      CALCK
         REF      CALBAD
         REF      TRAPEXIT,T:ACCTOV
*                 REFS TO GENERAL DATA.
          REF       RNST,EXITBITS
         REF      M3,M17
         REF      T:JOBENT#
         REF      TRNC
         REF      DLTSEG
         REF      MSRTFILE#
         REF      :BIG
         REF      J:CALCNT
         REF      CC1SET
         REF,1    JB:PROMPT
         REF      CC1RST
         REF      MISOVSEG,IODTYSEG
         REF      JXBUFVP,JX:CMAP
LI0      CNAME
         PROC
LF       LI,0     AF(1)
         PEND
         PAGE
*                 IMMEDIATE CONSTANTS USED BY MONITOR.
K1       EQU      1
K1FFFF   EQU      X'1FFFF'
KN11     EQU      -17
         BOUND    8
M#UCM#XX PZE      M:UC              ADDRESSES OF M:UC AND
         PZE      M:XX               M:XX DCBS FOR CLM INSTRUCTION.
424:724  DATA     X'04000000'       SMALLEST 2-WORD DCB NAME.
         DATA     X'07FFFFFF'        LARGEST 2-WORD DCB NAME.
S:BUFMCW GEN,8,7,8,9   1,0,(BUFF1**-9-2)+:BIG+:BIG,0
         PAGE
CAL1P11  EQU      %
         LW,6     0                 L/ADDRESS OF CAL1 TRAP
*  INCREMENT CAL COUNT FOR PERFORMANCE MONITOR IF IT EXISTS,
*  ELSE INCREMENT REGISTER 0.
         MTW,1    C:CAL
         MTW,1    J:CALCNT
         LI,1     -15
         AW,1     TSTACK
         STW,1    J:BASE
         REF      J:BASE
ANLZSB   BAL,4    CVREG             GET CAL OR EXU
         LH,SR4   6                 FOR EXU CHK AND INDEX
         BGEZ     ANLZ1             SKIP IF NOT INDIRECT
         BAL,4    CVREG             GET DIRECT ADDRESS
ANLZ1    LW,D3    6
         LW,6     SR4
         SLS,6    -1                ALIGN INDEX FIELD
         AND,6    M3                EXTRACT INDEX FIELD
         BEZ      ANLZ2             SKIP IF NO INDEX
         LW,6     *J:BASE,6         GET INDEX VALUE
ANLZ2    AW,6     D3                ADD DIRECT ADDRESS
         CI,SR4   X'2000'           CHK EXU
         BANZ     ANLZSB            UNDO EXU CHAIN
         CI,6     X'1FFF0'          CHK REGISTER
         BANZ     %+2               SKIP IF NOT
         AW,6     J:BASE            REGISTER LOC IN STACK
         LI,R7    X'1FFFF'
         AND,R7   6                 PLIST ADDRESS
         LB,SR1   *R6               TYPE OF CAL BYTE
         LW,6     0,R7              DCB ADDR
         BGEZ     CAL1              SKIP IF NOT INDIRECT
         BAL,4    CVREG             GET DIRECT DCB ADDRESS
         AI,SR1   -X'80'            STRIP INDIRECT BIT
CAL1     AI,R7    1                 POINT TO PRESENCE BITS
         LI,SR4   TRAPEXIT
*                 SR4 = EXIT ADDR.,SR1 = CODE, R6 = FIRST WD OF PLIST.
         SLS,R3   -4
         CI,R3    HICAL
         BLE      C1TV,R3
         MTW,-1   J:CALCNT
FRGRND   EQU      0
         DO       FRGRND
         CI,R3    X'A'              CHECK IF CAL1,A                     758
         BNE      C1TV              NO-BRANCH                           758
         CI,SR1   1                 YES-CHECK IF SAVE/RESTORE ENV. CALL 758
         BL       SAVENVR           SAVE ENV.-BRANCH                    758
         BE       RSTRENV           RESTORE ENV.-BRANCH                 758
         SREF     SAVENVR,RSTRENV
         FIN
C1TV     EQU      %
         B        CALCK
         B        CAL11
         B        CAL12
HICAL    EQU      %-C1TV-1
         PAGE
CAL11    EQU      %
         LI,1     8                 JUSTIFY
         MSP,1    TSTACK             STACK
         AI,7     -1
         B        CAL11M
CAL11N3  LB,8     6                 GET FUNCTION CODE
         DEF      CAL11N3
         MTW,1    C:CAL
CAL11M   RES      0
         AND,R6   M17               R6 = DCB ADDRESS.
         CLM,R6   M#UCM#XX          TRY THE EASY ONES FIRST:
         BCR,12   CAL11N8           ---> M:XX DCB.
         BCS,3    CAL11N4           ---> NOT M:UC DCB.
         LC       J:JIT             M:UC IS:
         BCS,12   CAL11N9           ---> LEGAL ONLINE/GHOST.
         B        CAL11X2         -----> ILLEGAL IN BATCH.
CAL11N4  LW,1     J:DCBLINK         R1 => USER DCB NAME LIST.
         LW,2     1,1               R2 = WORD 1 OF FIRST DCBNAME.
         CW,2     TXTCFU            IS FIRST DCB CFUAREA NON-DCB...
         BE       CAL11N5           ---> IT IS; SKIP IT.
         BCR,6    CAL11X1           ---> (DCBLINK=0 OR NO DCBS)
         AI,1     -2                NO CFUAREA NON-DCB; BACK UP.
*
CAL11N5  AI,1     3                 R1 => NEXT DCB NAME.
         LW,2     0,1               R2 = FIRST WORD OF DCB NAME.
         BNEZ     CAL11N6           ---> MORE DCBS; KEEP LOOKING.
CAL11X1  CI,R6    M:OC              NO MORE USER DCBS. LAST CHANCE:
         BE       CAL11N9           ---> M:OC DCB.
CAL11X2  LI,2     -8                * IT'S NOT A VALID DCB.
         MSP,2    TSTACK            * REMOVE PUSHALL SPACE FROM STACK.
         CI,SR1   X'2C'             * SET-PROMPT CAL DOESNT NEED DCB.
         BE       T:STPMT           * ---> M:PC CAL.
         LI,14    X'AF'             *** ILLEGAL-DCB ERROR CODE.
         B        CALBAD          --***----> GO ABORT USER.
*
CAL11N6  CLM,2    424:724           SEE HOW LONG DCB NAME IS:
         BCR,9    CAL11N6B          ---> 2 WORDS (4-7 CHAR.)
         BCS,1    CAL11N6A          ---> 1 WORD  (0-3 CHAR.)
         SLS,2    -10                   >2 WORDS ( >7 CHAR.)
         AH,1     2                 R1 => DCBNAME END.
CAL11N6A AI,1     -1                R1 => DCBNAME-END - 1.
CAL11N6B CW,R6    2,1               DOES THE CAL1 WANT THIS DCB...
         BNE      CAL11N5           ---> NO. KEEP LOOKING.
CAL11N8  LI,1     X'1FF'**2         DCB ADDRESS VALID, NOT UC OR OC.
         LW,0     J:CALCNT          PUT CAL COUNT(21-29) INTO DCB.
         SLD,0    15-2              USED FOR RE-USING BLOCKING
         STS,0    AGER,R6            BUFFERS (OLDEST FIRST).
*
         LW,0     0,R6              LOAD DCB BLOCKING BUFFER PAGES
         CW,0     Y002               INTO USER'S MAP IF APPROPRIATE.
         BAZ      CAL11N9           ---> DCB NOT OPEN; NO BUFFERS.
         AND,0    M4
         AI,0     -2
         BGZ      CAL11N9           ---> NOT FILE/LABEL; NO BUFFERS.
         LI,R1    BUFF1**-9         PAGE NUMBER INDEX FOR BUFF1
         LI,R2    X'1F'             MASK TO EXTRACT BUFF1
         AND,R2   AGER,R6           GET IT
         BEZ      1A17              NONE
         AI,R2    JXBUFVP-1         CONVERT TO CMAP INDEX
         LOAD,R12 JX:CMAP,R2        GET PAGE NUMBER OF BUFFER
         STORE,R12 JX:CMAP,R1       AND PLACE IN BUFF1 WINDOW
1A17     LI,R2    X'1F'**5          MASK TO EXTRACT BUFF2
         AND,R2   AGER,R6           GET IT
         BEZ      1A19              NONE
         SLS,R2   -5                ALIGN
         AI,R2    JXBUFVP-1         CONVERT TO CMAP INDEX
         LI,R1    BUFF2**-9         PAGE NUMBER INDEX FOR BUFF2
         LOAD,R12 JX:CMAP,R2        GET PAGE NUMBER FOR BUFF2
1A18     STORE,R12 JX:CMAP,R1       AND MOVE TO WINDOW FOR BUFF2
1A19     ANLZ,R12 1A18              GET ADDRESS OF WINDOW
         SLS,R12  :BIG-2            WORD ADDRESS
         LW,R13   S:BUFMCW          COUNT AND START PAGE NUMBER
         LDMAP,R12 0                RELOAD THE WINDOW
CAL11N9  EQU      %
         LI,SR4   IOSPRTN
         CI,8     16                BRANCH
         BE       SETFLG1            IF READ
         CI,8     17                BRANCH
         BE       GORDWT1            IF WRITE
         CI,8     X'29'             BRANCH
         BE       IOCHEK             IF CHECK
         CI,8     X'2D'             A-M READ
         BL       %+3
         CI,8     X'2F'
         BL       CAL11N7           A-M READ OR WRITE
         AI,7     1
         LI,1     -8                JUSTIFY
         MSP,1    TSTACK             STACK
CHKRLOP3 LI,R1    NC11S
CHKCAL1  CB,SR1   C11CDS,R1
         BNE      CHKCAL2
         CI,6     M:UC              IS IT UC DCB?
         BE       BADCAL            ONLY READ/WRITE/DEV CALS ALLOWED
         LI,D4    MISOVLY
         EXU      C11TV+3,R1
C11TV    EQU      %
         REF      CAL1PSD
         LI,1     X'1FFFF'
         AND,1    CAL1PSD
         CI,1     J:JIT
         BG       *D4               NO REMEMBER IF NOT MNTR
         REMEMBER
         B        *D4
         LIF      EPCLS
         LIF      EPCVOL
         LIF      EPOPN
                  LI0      PFIL#
                  LI0      PRECORD#
         LIF      EPDEL
                  LI0      REW#
                  LI0      WEOF#
         LIF      TRNC
         LI0      MSRTFILE#
         B        TRAPEXIT
         LIF      EPMOVE
         LI0      T:JOBENT#         JOB ENTRY
NC11S    EQU      15
         SPACE    2
C11CDS   RES,1    1
         DATA,1   X'29',X'29'
         DATA,1   X'15'             CLOSE
         DATA,1   X'3'              CVOL
         DATA,1   X'14'             OPEN
         DATA,1   X'1C'             PFIL
         DATA,1   X'1D'             PRECORD
         DATA,1   X'D'              DELETE
         DATA,1   X'1'              REW
         DATA,1   X'2'              WEOF
         DATA,1   X'12'             TRUNC
         DATA,1   X'F'              TFILE
         DATA,1   X'C'
         DATA,1   X'E'
         DATA,1   X'2F'             JOB ENTRY
         BOUND    4
         SPACE    2
DEVCDS   RES,1    1              M:DEVICE
         DATA,1   X'24'             COUNT
         DATA,1   X'23'             DATA
         DATA,1   X'21'             FORM
         DATA,1   X'26'             HEADER
         DATA,1   X'20'             LINES
         DATA,1   X'22'             MODE
         DATA,1   X'4'              PAGE
         DATA,1   X'27'             SEQ
         DATA,1   X'25'             SPACE
         DATA,1   X'28'             TAB
         DATA,1   X'5'              VFC
         DATA,1   X'B'              DIR
         DATA,1   6               SETDCB
         DATA,1   X'2A'             NLINES
         DATA,1   X'2B'             CORRES
NC11DEVS EQU      BA(%)-BA(DEVCDS)-1
         BOUND    4
         SPACE    5
EPOPN    OVERTO   OPNSEG,0
EPCLS    OVERTO   CLSSEG,2          SPECIAL CALPROC ENTRY POINT
EPDEL    OVERTO   DLTSEG,4
EPCVOL   OVERTO   LBLTSEG,2
EPMOVE   OVERTO   LBLTSEG,6
CAL12    LI,R1    NC12S
         LIF      MERC
CHKCAL3  CB,SR1   C12CDS,R1
         BNE      CHKCAL4
         LI0      0
         EXU      C12TV+1,R1
         LI,11    TRAPEXIT
         CI,0     0
         BE       C12TV
IODTYOVLY EQU     %
         LI,2     IODTYSEG
         B        T:OVERLAY
CHKENQ   EQU      %                 ENQ CAL...IF NO QT TABLES, ENQ IS
         LI,R0    QT                         NOT IN SYSTEM
         BEZ      CALBAD
*                      ENQ/DEQ IN SYSTEM-IF ENQ RESIDENT, GO
         LI,11    IOSPRTN
         B        ENQ
         SREF     QT,ENQ
MSRKEY   LI,0     MSRKEY#
MISOVLY  EQU      %
         LI,2     MISOVSEG
         B        T:OVERLAY
C12TV    EQU      %
         BAL,SR4  *D4
         B        TRAPEXIT
         LIF      MSRKEY
         B        MERCAL
         LIF      MSRTYPR
         LIF      MSRTYPR
         LIF      MSROCTY
         B        CHKENQ            ENQ
         B        CHKENQ            DEQ
NC12S    EQU      %-C12TV-2
         SPACE    2
MERCAL   EQU      %
         LI,11    IOSPRTN           RETURN POINT FROM MERCAL
         B        C11TV
C12CDS   RES,1    1
         DATA,1   4                 KEYIN
         DATA,1   16                MERC
         DATA,1   1                 PRINT
         DATA,1   2                 TYPE
         DATA,1   0                 M:MESSAGE
         DATA,1   8                 ENQ
         DATA,1   9                 DEQ
         BOUND    4
         SPACE    5
CHKCAL4  BDR,R1   CHKCAL3
         B        BADCAL
CHKCAL2  BDR,R1   CHKCAL1
         AI,7     -1
         LIF      IOSDEV
         LI,R1    NC11DEVS
         CB,SR1   DEVCDS,R1
         BNE      %+2
         B        C11TV
         BDR,R1   %-3
BADCAL   LI,14    X'AE'
         B        CALBAD
CVREG    CI,6     X'1FFF0'          CHK REG
         BANZ     %+2               SKIP IF NOT
         AW,6     J:BASE            REG LOC IN STACK
         LW,6     0,6               GET CONTENTS
         B        0,4               RETURN
         PAGE
T:STPMT  EQU      %                 SET COC PROMPT CHARACTER
         MTW,0    J:JIT             ERRROR IF NOT
         BGEZ     CC1SET            ONLINE USER
         LI,1     JB:PROMPT
         STB,6    0,1               SAVE IN JIT FOR SAVE
         B        CC1RST
         PAGE
SETFLG1  EQU      CAL11N7
GORDWT1  EQU      CAL11N7
*
*                 RETURN FROM IOSP.  CHECK RNST. IF SET, TAKE ACTION
*                 BEFORE ERR,ABN ACTION. IF CLEAR, SR1=0 IMPLIES ORD-
*                 INARY EXIT. NOT 0 MEANS PSD+1 TO SR1, SR3 TO SR3,
*                 SR1 TO PSD.
*
         DEF      IOSPRTN
IOSPRTN  EQU      %
         AI,SR1   0
         BEZ      TRAPEXIT
         LW,R1    RNST+J:JIT
         CW,R1    EXITBITS
         BANZ     TRAPEXIT
         LW,R1    TSTACK
         STW,SR3  -5,R1
         AI,R1    KN11
         LD,R2    *R1
         LI,SR2   K1FFFF
         AI,R2    K1
         STW,R2   10,R1
         STS,SR1  R2
         STD,R2   *R1
         B        T:ACCTOV
         END

