*M*      CALPROC  CAL1 DISPATCHER
S69PROC  SET      1
MONPROC  SET      1
         PCC      0
         SYSTEM   UTS
         PAGE
*P*      NAME:    CALPROC
         SPACE    1
*P*      PURPOSE:
*P*               TO PERFORM THE INITIAL DECODING OF THE CAL1,1
*P*               AND CAL1,2 (I/O RELATED) CALS AND TRANSFER
*P*               TO THE APPROPRIATE SERVICE MODULE
*P*               THIS MODULE ALSO CONTAINS A COMMON EXIT POINT
*P*               FOR I/O  CALS, IOSPRTN, WHICH ASCERTAINS
*P*               IF AN ABNORMAL OR ERROR CONDITION OCCURRED DURING
*P*               THE CAL PROCESSING AND TAKES APPROPRIATE ACTION
         SPACE    1
*P*      DESCRIPTION:
*P*               THERE ARE THREE MAJOR ROUTINES WITHIN THIS MODULE
         SPACE    1
*P*               CAL1P11 - FOR STANDARD CAL1 PROCESSING
*P*               IN THIS ROUTINE THE INITIAL DECODING OF THE CAL
*P*               IS PERFORMED ENDING IN A SWITCH BEING  EXECUTED ON THE
*P*               R-FIELD OF THE CAL. IF IT IS NOT A CAL1,1 OR CAL1,2
*P*               THEN CONTROL IMMEDIATELY GOES TO ALTCP FOR
*P*               FURTHER PROCESSING.
*P*               IF IT IS A CAL1,2 THEN THE CODE IS CHECKED AND CONTROL
*P*               TRANSFERRED TO THE APPROPRIATE SERVICE MODULE
*P*               IF IT IS A CAL1,1 THEN CONTROL PASSES INTO THE FAST
*P*               CAL PROCESSING PATH
         SPACE    1
*P*               CAL11N3 AND CAL11NB  - FOR FAST CAL1,1 PROCESSING
*P*               THIS ROUTINE VALIDATES THE DCB ADDRESS (INSURING THAT
*P*               THE DCB IS EITHER IN THE DCB TABLE OR IS M:UC OR M:XX
*P*               OR THE CAL IS AN M:PROMPT) AND ALSO
*P*               IF THE DCB IS ASSIGNED TO A DISK FILE OR LABELLED TAPE
*P*               THEN THE CORRECT PHYSICAL PAGE IS PUT INTO CMAP
*P*               IN THE WINDOW SLOTS (BUFF1 AND BUFF2) AND THE
*P*               MAP FOR THOSE PAGES IS RELOADED
*P*               THE ROUTINE THEN DECODES THE SPECIFIC FPT
*P*               FUNCTION CODE AND TRANSFERS CONTROL TO THE
*P*               APPROPRIATE SERVICE MODULE
         SPACE    1
*P*               IOSPRTN - FINAL EXIT FROM ALL CAL1S
*P*               IF NO ERROR HAS BEEN DETECTED THIS ROUTINE EFFECTS
*P*               AN IMMEDIATE RETURN TO TRAPEXIT IN SCHED
*P*               WHICH CAUSES THE TRAP PSD (FROM THE ISSUING CAL1)
*P*               TO BE INCREMENTED BY 1.
*P*               IF AN ERROR HAS BEEN DETECTED THEN THE USER'S PSD IS
*P*               MODIFIED TO REFLECT HIS ERROR OR ABNORMAL
*P*               ADDRESS AND RETURN IS MADE TO SCHED AT T:ACCTOV
*P*               SUCH THAT NO ADJUSTMENT IS MADE TO THE PSD.
         PAGE
         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
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         PAGE
*
*        DEFS
*
         DEF      CALPROC:          PATCHING DEF
         DEF      CAL1P11           ENTRY FOR STANDARD CAL PROCESSING
         DEF      CAL11N3           ENTRY FOR FAST CA1,1 PROCESSING
         DEF      CAL11NB           ENTRY FOR FAST CAL1,1 PROCESSING
*,*                                 WHEN FUNCTION CODE ALREADY IN R8
         DEF      S:BUFMCD          MAP CONTROL DOUBLEWORDS
*,*                                 (NOT-:BIG FOLLOWED BY :BIG)
*,*                                 FOR MAPPING BUFF1 & BUFF2.
         DEF      IOSPRTN           ENTRY FOR COMMON EXIT POINT FOR MOST
*,*                                 I/O CALS
         PAGE
*
*        REFS
*                 CAL ROUTINES (MONITOR SERVICES)
*
         REF      CAL11N7           EXIT TO PROCESS READ/WRITE CALS
         REF      OPNSEG            OPEN OVERLAY SEGMENT NUMBER
         REF      CLSSEG            CLOSE OVERLAY SEGMENT NUMBER
         REF      DLTSEG            CLOSE OVERLAY SEGMENT NUMBER
         REF      LBLTSEG           LTAPE OVERLAY SEGMENT NUMBER
         REF      MISOVSEG          MISOV OVERLAY SEGMENT NUMBER
         REF      PFIL#             ENTRY POINT FOR PFIL CAL IN MISOV
         REF      PRECORD#          ENTRY POINT FOR PRECORD CAL IN MISOV
         REF      REW#              ENTRY POINT FOR PFIL CAL IN MISOV
         REF      WEOF#             ENTRY POINT FOR WEOF CAL IN MISOV
         REF      MSRTFILE#         ENTRY POINT FOR TFILE CAL IN MISOV
         REF      MSRKEY#           ENTRY POINT FOR KEYIN CAL IN MISOV
         REF      T:JOBENT#         ENTRY POINT FOR JOB CAL IN MISOV
         REF      IOSDEV            EXIT TO SET UP DEVICE DEPENDENT OPTS
         REF      MSROCTY           EXIT TO PROCESS PRINT/MESSAGE CALS
         REF      MSRTYPR           EXIT TO PROCESS TYPE CALS
         REF      MERC              EXIT TO PROCESS MERC CALS
         REF      IOCHEK            EXIT TO PROCESS CHECK CALS
         REF      CALCK             EXIT TO PROCESS CAL1S OTHER
*,*                                 THAN CAL1,1 & CAL1,2
         REF      CALBAD            EXIT FOR BAD CAL PROCESSING
         REF      TRNC              EXIT TO PROCESS TRUNC CALS
         REF      T:OVERLAY         EXIT TO LOAD A MONITOR OVERLAY
*,*                                 AND REMEMBER A RETURN
         SREF     QT                MONITOR RESIDENT ENQUEUE TABLES
         SREF     ENQ               EXIT TO PROCESS ENQUEUE/DEQUEUE CALS
         REF      CC1RST            EXIT WHEN CC1 TO BE RESET WHEN
*,*                                 RETURN TO CAL+1
         REF      TRAPEXIT          EXIT IN SCHED AT COMPLETION OF I/O
*,*                                 CAUSES TRAP PSD TO BE BUMPED 1
         REF      T:ACCTOV          EXIT TO SCHED AT COMPLETION OF I/O
*,*                                 WHEN PSD NOT TO BE CHANGED
*
*        REFS
*                 GENERAL DATA
*
         REF      M:UC              M:UC DCB ADDRESS
         REF      M:XX              M:XX DCB ADDRESS
         REF      J:JIT             THE JIT
         REF      TSTACK            THE TSTACK
         REF      TXTCFU            TEXTC OF M:*
         REF      J:DCBLINK         ADDRESS OF DCB TABLE
         REF      :BIG              FLAG TO INDICATE SYSTEM GENERATED
*,*                                 FOR > 128K CORE ( 1= YES)
         REF      J:CALCNT          CAL1 COUNT FOR CURRENT USER
         SREF     C:CAL             TOTAL # OF CAL1S
         REF,1    JB:PROMPT         CURRENT PROMPT CHARACTER FOR USER
*,*                                 AS BYTE ADDRESS
         REF      JXBUFVP           VP # START OF JIT MAP IMAGE
         REF      JX:CMAP           PHYSICAL PAGE TABLE
         REF      J:BASE            CONTAINS PTR TO USERS REGS IN TSTACK
         REF      M3                MASK
         REF      M17               MASK
         PAGE
         PAGE
CALPROC: RES
*
*
*
AGER     EQU      9                 DCB WD9 HAS CAL AGE,BUFF ADDRESSES
SETFLG1  EQU      CAL11N7
GORDWT1  EQU      CAL11N7
         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.
ADDR:ADDR DATA    X'0001FFFF'       DOUBLEWORD CONTAINING TWO
         DATA     X'0001FFFF'        ADDRESS MASKS.
S:BUFMCD PZE      WA(JX:CMAP)+BUFF1**-9/4   MAP BUFF1/BUFF2 ON
         GEN,8,24 1,BUFF1&X'1F800'            128K MACHINE.
         PZE      WA(JX:CMAP)+BUFF1**-9/2   MAP BUFF1/BUFF2 ON
         GEN,8,24 1,BUFF1&X'1FC00'           >128K MACHINE.
         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
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
C1TV     EQU      %
         B        CALCK
         B        CAL11
         B        CAL12
HICAL    EQU      %-C1TV-1
         PAGE
CAL11    EQU      %
         ENABLE                     ALLOW INTERRUPTS NOW
         LI,1     8                 JUSTIFY
         MSP,1    TSTACK             STACK
         AI,7     -1
         B        CAL11M
CAL11N3  LB,8     6                 GET FUNCTION CODE
CAL11NB  EQU      %
         MTW,1    C:CAL
CAL11M   RES      0
*D*               CAL11DCB TESTS VALIDITY OF A CAL1,1'S DCB ADDRESS.
*D*               R6=DCB ADDRESS INPUT TO CAL11DCB, BUT WITH POSSIBLE
*D*                 HIGH-ORDER GARBAGE THAT MUST BE MASKED OFF.
*D*               DCB ADDRESS IS LEGAL IF --
*D*               1. IT IS M:XX OR M:UC.
*D*               2. THE CAL1 FPT CODE (IN SR1) IS X'2C'.
*D*                  (THIS IS M:PC CAL, WHICH HAS NO DCB ADDRESS.)
*D*               3. DCB IS ON THE DCB NAMELIST. FORMAT OF NAMELIST --
*D*                  J:DCBLINK CONTAINS WA(NAMELIST BLOCK).
*D*                  NAMELIST BLOCK CONSISTS OF ONE UNUSED WORD,
*D*                    THEN A STRING OF (TEXTC DCBNAME, DCB ADDRESS)
*D*                    ENTRIES, THEN A WORD WHICH IS ZERO OR THE
*D*                    ADDRESS OF ANOTHER NAMELIST BLOCK.
*D*                    IF THE FIRST TEXTC DCBNAME IN A BLOCK IS 'M:*'
*D*                    (CFUDCB), IT ISN'T REALLY A DCB AND AN ADDRESS
*D*                    MATCH IS NOT A LEGAL DCB.
*D*               CAL11DCB IS ON THE FAST CAL PATH, SO IT IS CODED FOR
*D*                  SPEED.  DCB-ON-NAMELIST IS ABOUT 20 TIMES AS
*D*                  PROBABLE AS M:XX/M:UC, BUT THE M:XX/M:UC CASE IS
*D*                  TESTED FIRST BECAUSE AN UNSUCCESSFUL NAMELIST
*D*                  SEARCH TAKES MORE LIKE 30 TIMES AS LONG AS THE
*D*                  M:XX/M:UC TEST.  90% OF DCB NAMES ARE 2 WORDS
*D*                  LONG.  ABOUT 5 NAMELIST MISMATCHES OCCUR BEFORE
*D*                  THE DCB IS FOUND.  M:PC AND ILLEGAL DCB ARE
*D*                  VERY RARE.
*D*               REGISTERS ---
*D*               R0 PRESERVED (CAL1 PSW0)
*D*               R5 PRESERVED
*D*               R6 DCB ADDRESS, HIGH-ORDER GARBAGE ZEROED.
*D*               R7 PRESERVED
*D*               R8(SR1) FPT CODE, PRESERVED
*D*               R3 OUTPUT POINTS TO 2 BEFORE DCB ADDRESS IN NAMELIST
*D*
*D*                           +----- SETUP CODE EXECUTED ONCE
*D*                           |+---- MULTIPLE NAMELIST BLOCK LOOP
*D*                           ||+--- 1-WORD DCBNAME LOOP
*D*                           |||+-- 2-WORD DCBNAME LOOP
*D*                           ||||+- >2-WORD DCBNAME LOOP
CAL11DCB EQU      %           VVVVV
         AND,R6   M17         S     REMOVE GARBAGE FROM DCB ADDRESS.
         CLM,R6   M#UCM#XX    S     TRY SPECIAL DCBS FIRST.
         BCS,1+8  11D4        S     ---> NO.
         BCR,12   CAL11MAP          ---> M:XX. MAP BUFFERS.
         BCR,3    11D5              ---> M:UC. (MAY BE ILLEGAL)
11D4     LD,R2    ADDR:ADDR   S     R2/R3 ARE TWO ADDRESS-ONLY MASKS.
         LD,R12   424:724     S     R12/R13 ARE LIMITS OF 2-WORD TEXTC
         AND,R3   J:DCBLINK   S     GET ADDRESS OF DCB NAMELIST.
         BNEZ     11D6        S     ---> GO TRY TO MATCH DCB ADDRESS.
CAL11X   EQU      %                 ***   ILLEGAL DCB ADDRESS.
         LI,R3    -8
         MSP,R3   TSTACK            CRANK DOWN STACK TO USER ENVIRON.
*********************************************************************
         BLOCK                      SLAVE USER WILL BE PARKED HERE
*********************************************************************
         CI,SR1   X'2C'             LAST CHANCE -- M:PC DOESNT USE DCB
         BE       T:STPMT           ---> GOT M:PC CAL.
*E*               ERROR AF-00.
*E*               DESCRIPTION: CAL1,1 REFERENCES NONEXISTENT DCB.
         LI,R14   X'AF'
         B        CALBAD
11D5     LC       J:JIT                  M:UC IS A NO-NO IN BATCH.
         BCS,12   CAL11FPT          ---> M:UC. SKIP BUFFER MAPPING.
         B        CAL11X            ---> ILLEGAL DCB ADDRESS.
*
11D01    CW,R2    0,R3         M1   DISTINGUISH 1-WD NAME, BLOCK END.
         BL       11D1         M1   ---> 1 WORD DCBNAME.
         LW,R3    0,R3         M    BLOCK END.  IS THERE A LINK...
         BEZ      CAL11X       M    ---> NO. ILLEGAL DCB ADDRESS.
11D6     LW,R1    1,R3        SM    START OF NAMELIST BLOCK.
         CW,R1    TXTCFU      SM    IS FIRST DCBNAME M:*...
         BE       11D8        SM    ---> YES. SKIP IT.
         AI,R3    -2                NO. START WITH IT.
11D8     AI,R3    3             12> POINT TO NEXT DCBNAME.
         CLR,R12  0,R3          12> SEE HOW LONG DCBNAME IS --
         BCR,6    11D2          12> ---> 2 WORDS.
         BCS,2    11D01         1 > ---> 1 WORD OR END OF BLOCK.
         LW,R1    0,R3            > MORE THAN 2 WORDS LONG.
         SLS,R1   -10             > GET #WORDS IN DCBNAME MINUS 1.
         AH,R3    R1              > POINT PAST NAME MINUS 1.
11D1     AI,R3    -1            1 > POINT PAST NAME MINUS 2.
11D2     CW,R6    2,R3          12> LOOK FOR ADDRESS MATCH.
         BNE      11D8          12> ---> NOT FOUND; KEEP LOOKING.
CAL11MAP EQU      %                 MAP DCB'S BLOCKING BUFFERS.
         LI,R13   X'1FF'**2
         LW,R12   J:CALCNT          FIRST REMEMBER APPROXIMATELY WHEN
         SLD,R12  15-2              THE LAST CAL WAS DONE TO THIS DCB.
         STS,R12  AGER,R6           AGER(8-16) = J:CALCNT(21-29).
*D*               MAP THE DCB'S BLOCKING BUFFERS.
*D*               THIS CODE ASSUMES THAT THE BLOCKING BUFFER WINDOW
*D*               PAGES ARE AN EVEN/ODD PAGE PAIR (BUFF1 EVEN),
*D*               AND THAT THE BUFFER INDEX FIELDS IN THE DCB ARE
*D*               IN THE SAME WORD, AND THAT THE BUFF2 INDEX IS
*D*               BITS 22-26, AND THE BUFF1 INDEX IS BITS 27-31.
         LI,R2    BUF2MSK+BUF1MSK   MASK TO GET BUFFER INDEXES.
         AND,R2   BUFX,R6           GET BUFFER INDEXES.
         BEZ      CAL11FPT          ---> NO BUFFERS; DON'T MAP.
         SLS,R2   -5                GET BUFF2 INDEX.
         AI,R2    0                 ANY BUFF2...
         BEZ      11M1              ---> NO.
         AI,R2    JXBUFVP-1         CONVERT INDEX TO CMAP PAGE.
         LI,R1    BUFF2**-9         GET WINDOW PAGE NUMBER.
         LOAD,R12  JX:CMAP,R2       GET REAL PAGE NUMBER AND
         STORE,R12 JX:CMAP,R1       PUT INTO WINDOW MAP PAGE.
11M1     LI,R2    BUF1MSK           NOW FOR BUFF1.
         AND,R2   BUFX,R6           ANY BUFF1...
         BEZ      11M2              ---> NO.
         AI,R2    JXBUFVP-1         CONVERT INDEX TO CMAP PAGE.
         LI,R1    BUFF1**-9         GET WINDOW PAGE NUMBER.
         LOAD,R12  JX:CMAP,R2       GET REAL PAGE NUMBER AND
         STORE,R12 JX:CMAP,R1       PUT INTO WINDOW MAP PAGE.
11M2     LD,R12   S:BUFMCD+:BIG+:BIG GET THE PROPER MAP LOADING DW AND
         LDMAP,R12 0                LOAD THE MAP FOR THESE PAGES.
CAL11FPT EQU      %
*
*
*
         LI,SR4   IOSPRTN
         CI,8     16                BRANCH
         BE       SETFLG1            IF READ
         CI,8     17                BRANCH
         BE       GORDWT1            IF WRITE
**************************************************
         BLOCK                      SLAVE USER WILL BE PARKED HERE
**************************************************
         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
         EXU      C11TV,R1
C11GO    EQU      %
         AND,R0   M17               SEE IF CAL1 WAS DONE IN
         CI,R0    J:JIT             THE MONITOR; IF SO,
         BG       *R15
         REMEMBER                   REMEMBER OUR CURRENT OVERLAY.
         B        *R15
C11TV    EQU      %-1
         LI,R15   EPCLS             15 M:CLOSE
         LI,R15   EPCVOL            03 M:CVOL
         LI,R15   EPOPN             14 M:OPEN
         LI,R15   MISOVC11          1C M:PFIL
         LI,R15   MISOVC11          1D M:PRECORD
         LI,R15   EPDEL             0D M:DELREC
         LI,R15   MISOVC11          01 M:REW
         LI,R15   MISOVC11          02 M:WEOF
         LI,R15   TRNC              12 M:TRUNC
         LI,R15   MISOVC11          0F M:TFILE
         B        TRAPEXIT          0C M:RELREC
         LI,R15   EPMOVE            0E M:MOVE
         LI,R15   MISOVC11          2F M:JOB
NC11S    EQU      %-C11TV-1
C11CDS   DATA,1   0
         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    3
MISOVC11 LB,0     MISOVCDS,R1       GET E.P.#
         B        MISOVLY           AND GO TO MISOV OVERLAY.
MISOVCDS DATA,1   -1
         DATA,1   -1 M:CLOSE
         DATA,1   -1 M:CVOL
         DATA,1   -1 M:OPEN
         DATA,1   PFIL#             M:PFIL
         DATA,1   PRECORD#          M:PRECORD
         DATA,1   -1 M:DELREC
         DATA,1   REW#              M:REW
         DATA,1   WEOF#             M:WEOF
         DATA,1   -1 M:TRUNC
         DATA,1   MSRTFILE#         M:TFILE
         DATA,1   -1
         DATA,1   -1 M:MOVE
         DATA,1   T:JOBENT#         M:JOB
         BOUND    4
         SPACE    3
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    ENABLE                     LET 'EM COME NOW
*                 R0 CAL1 PSW0.
*                 R6 FPT WORD 0 (GONE INDIRECT)
*                 R7 -> FPT WORD 1.
*                 SR1 FPT CODE.
*                 SR4 =<TRAPEXIT>.
         LI,R1    NC12S
         CB,SR1   C12CDS,R1         LOOK FOR FPT CODE IN VALID LIST.
         BE       C12TV,R1          --->FOUND; GO TO ASSOC ROUTINE.
         BDR,R1   %-2
         B        BADCAL            NOT FOUND; CAL IS BAD.
C12TV    EQU      %-1
         B        MSRKEY            04 M:KEYIN
         B        MERCAL            10 M:MERC
         B        MSRTYPR           01 M:PRINT
         B        MSRTYPR           02 M:TYPE
         B        MSROCTY           00 M:MESSAGE
         B        CHKENQ            08 M:ENQ
         B        CHKENQ            09 M:DEQ
NC12S    EQU      %-C12TV-1
C12CDS   DATA,1   0
         DATA,1   X'04'             M:KEYIN
         DATA,1   X'10'             M:MERC
         DATA,1   X'01'             M:PRINT
         DATA,1   X'02'             M:TYPE
         DATA,1   X'00'             M:MESSAGE
         DATA,1   X'08'             M:ENQ
         DATA,1   X'09'             M:DEQ
         BOUND    4
MERCAL   EQU      %
         LI,SR4   IOSPRTNM          RETURN POINT FOR M:MERC CAL
         LI,R15   MERC              ENTRY POINT FOR M:MERC CAL
         B        C11GO             --->NOW DO IT LIKE CAL1,1'S.
CHKENQ   EQU      %                 ENQ CAL...IF NO QT TABLES, ENQ IS
         LI,R0    QT                         NOT IN SYSTEM
         BEZ      BADCAL
*                      ENQ/DEQ IN SYSTEM-IF ENQ RESIDENT, GO
         LI,11    IOSPRTN
         B        ENQ
MSRKEY   LI,0     MSRKEY#
MISOVLY  EQU      %
         LI,2     MISOVSEG
         B        T:OVERLAY
         SPACE    5
CHKCAL2  BDR,R1   CHKCAL1
         AI,7     -1
         LI,R15   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
         LI,1     JB:PROMPT
         STB,6    0,1               SAVE IN JIT FOR SAVE
         B        CC1RST
         PAGE
*
*D*      NAME:         IOSPRTN
*D*
*D*      ENTRY:        IOSPRTNM
*D*
*D*      REGISTERS:    ALL VOLATILE
*D*
*D*      CALL:         BRANCH
*D*
*D*      INTERFACE:    TRAPEXIT, T:ACCTOV
*D*
*D*      INPUT:        TOP 19 WORDS OF TSTACK CONTAIN USER CAL ENVIRON.
*D*                    SR1 = ZERO IF NO ERROR, OTHERWISE THE USER
*D*                          ADDRESSS TO RETURN TO.
*D*                    SR3 = VALUE TO BE PUT INTO USER SR3 (ONLY IF
*D*                          SR1 NON-ZERO).
*D*                    J:BASE POINTS TO USER'S R0 (IOSPRTNM ONLY).
*D*
*D*      OUTPUT:       NONE IF SR1=0.  OTHERWISE, SR1 AND SR3 ARE
*D*                    PLACED IN USER SR1 AND SR3, AND USER PSD
*D*                    ADDRESS IS CHANGED TO LOW ORDER 17 BITS OF SR1.
*D*
*D*                    IF SR1 = 0 (NO ERROR), GO TO TRAPEXIT WHICH
*D*                    RETURNS TO CAL+1.  IF ERROR, CHANGE USER SR1 AND
*D*                    SR3 AND USER PSD, & RETURN TO USER VIA T:ACCTOV.
*D*
*D*                    IOSPRTNM IS RETURN FROM M:MERC CAL.  SR1 IS
*D*                    FORCED TO BE THE USER'S SR1, WHICH IS THE ADDRESS
*D*                    TO RETURN TO.
*D*
*D*      DESCRIPTION:  FINAL EXIT FROM ALL CAL1'S.
*D*
         PAGE
IOSPRTNM LI,R1    SR1
         LW,SR1   *J:BASE,R1        GET USER'S SR1
IOSPRTN  EQU      %
         AI,SR1   0
         BEZ      TRAPEXIT
         LW,R1    TSTACK
         STW,SR3  -5,R1
         AI,R1    -17
         LD,R2    *R1
         LI,SR2   X'1FFFF'
         AI,R2    1
         STW,R2   10,R1
         STS,SR1  R2
         STD,R2   *R1
         B        T:ACCTOV
         END

