*M*      ALTCP    PROCESSING OF CAL1,3 - CAL1,9 AND TRAP HANDLING
         PCC      0
MONPROC  SET      1
UTSPROC  SET      1
UFLAGS   SET      1
BITS     SET      1
MPBITS   SET      1
         SYSTEM   UTS
         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
R8       EQU      8
SR1      EQU      8
R9       EQU      9
SR2      EQU      9
R10      EQU      10
SR3      EQU      10
R11      EQU      11
SR4      EQU      11
R12      EQU      12
D1       EQU      12
R13      EQU      13
D2       EQU      13
R14      EQU      14
D3       EQU      14
R15      EQU      15
D4       EQU      15
         PAGE
*
*        DEFS
*
         DEF      ALTCP:            MODULE DEF FOR PATCHING
         DEF      40TRAP            ENTRY FOR PROCESSING TRAPS
*,*                                 X'40'-X'46'
         DEF      CALCK             ENTRY TO PROCESS CAL1,3-CAL19
         DEF      CALBAD            ENTRY TO PROCESS ILLEGAL CAL TRAPS
*,*                                 X'49'-X'4B' & UNDEFINED CAL1
         SPACE    2
         DEF      OUT               RTN TO RETURN CCS AS SET IN R12
         DEF      CC1SET            RTN TO RETURN WITH CC1 TO BE SET
         DEF      CC0RST            RTN TO RETURN WITH CC1&2 RESET
         DEF      CC1RST            RTN TO RETURN  WITN CC1 RESET
         DEF      CC2SET            RTN TO RETURN WITH CC2 SET
         DEF      MSTRAPXIT         EXIT RTN FROM PROCESSING M:STRAP CAL
         DEF      CKLIMIT           RTN TO RETURN MAX PROTECTION ON A
*,*                                 RANGE OF MEMORY
         DEF      RTCHK             RTN TO CHECK IF RT USER HAS
*,*                                 LOCKED SELF IN CORE
         DEF      TMPTOSTK          RTN TO MOVE USER'S TEMP STACK
*,*                                 TO TSTACK
         DEF      MTRTN0            RTN MERGER POINT OF M:INTRTN
*,*                                 PROCESSING WITH STD M:TRTN
         DEF      RTERR             ABORT CODE FOR RT USER ISSUING
*,*                                 RESTRICTED CAL AFTER LOCKING IN CORE
         DEF      MSTRUNC           RTN TO TRUNC DCBS,FREE FREE BUFS.
         PAGE
*
*        REFS
*                 SERVICE ROUTINES
*
         REF      T:ABORT           ENTRY PT TO PROCESS M:ABORT CAL
         REF      T:ABORTM          EXIT FOR MONITOR DETECTED ABORT
         REF      T:EXIT            ENTRY PT TO PROCESS M:EXIT CAL
         REF      T:ERROR           ENTRY PT TO PROCESS M:ERROR CAL
         REF      T:SMP             PROCESS M:SMPRT CAL
         REF      T:SAD             PROCESS M:CVM CAL
         REF      T:GL              PROCESS M:GL CAL
         REF      T:GVP             PROCESS M:GVP CAL
         REF      T:FVP             PROCESS M:FVP CAL
         REF      T:GDP             PROCESS M:GP CAL
         REF      T:FDP             PROCESS M:FP CAL
         REF      T:GCP             PROCESS M:GCP CAL
         REF      T:FCP             PROCESS M:FCP CAL
         REF      T:CAL#            PROCESS M:CAL
         REF      MULSEG            MULOV OVERLAY SEGMENT NUMBER
         REF      LDEV#             ENTRY PT TO PROCESS LDEV CAL
         REF      CCLOSE#           ENTRY PT TO PROCESS SUPERCLOSE CAL
         REF      MISOVSEG          MISOV OVERLAY SEGMENT NUMBER
         REF      T:ASSOCIATE#      ENTRY PT TO PROCESS ASSOC CAL
         REF      T:DISASSOCIATE#   ENTRY PT TO PROCESS DISASSOC CAL
         REF      T:CHTBL#          ENTRY PT TO PROCESS M:CT CAL
         REF      MSTRAP#           ENTRY PT TO PROCESS M:STRAP CAL
         REF      MTIME#            ENTRY PT TO PROCESS M:TIME CAL
         REF      SEGLD#            ENTRY PT TO PROCESS M:SEGLD CAL
         REF      MINT#             ENTRY PT TO PROCESS M:INT CAL
         REF      T:WAIT#           ENTRY PT TO PROCESS M:WAIT CAL
         SREF     UB:CALR
         REF      MXCON#            ENTRY PT TO PROCESS M:XCON CAL
         REF      T:GDDL#           ENTRY PT TO PROCESS M:GDDL CAL
         REF      MSTIMER#          ENTRY PT TO PROCESS M:STIMER CAL
         REF      MTTIMER#          ENTRY PT TO PROCESS M:TTIMER CAL
         REF      T:SAVEGET#        ENTRY PT TO PROCESS M:SAVE/GET CALS
         REF      DEBUGSEG          DEBUG OVERLAY SEGMENT NUMBER
         REF      LDLNKSEG          LDLNK OVERLAY SEGMENT NUMBER
         REF      RMAOVSEG          RMAOV OVERLAY SEGMENT NUMBER
         REF      T:RDERLOG#        ENTRY PT TO PROCESS READ ERRLOG CAL
         REF      T:WTERLOG#        ENTRY PT TO PROCESS WRITE ERRLOG CAL
         REF      T:MODPRTRT#       ENTRY PT TO PROCESS M:DMOD,M:DPART
*,*                                 M:DRET CALS
         REF      T:MAP#            ENTRY PT TO PROCESS M:MAP CAL
         REF      T:LOCK#           ENTRY PT TO PROCESS M:LOCK CAL
         REF      T:DOPEN#          ENTRY PT TO PROCESS DIAG. OPEN
         REF      T:DCLOSE#         ENTRY PT TO PROCESS DIAG. CLOSE
         REF      T:BLIST#          ENTRY PT TO PROCESS M:SIO/M:LIST CAL
         REF      TQOV1SEG          TP-QMGR OVERLAY SEGMENT NUMBER
         REF      TQOV2SEG          TP-CNM OVERLAY SEGMENT NUMBER
         REF      CNMPROC0#         ENTRY PT TO PROCESS M:GETLINE CAL
         REF      CNMPROC1#         ENTRY PT TO PROCESS M:RLSLINE CAL
         REF      CNMPROC2#         ENTRY PT TO PROCESS M:BUFSTAT CAL
         REF      CNMPROC3#         ENTRY PT TO PROCESS M:PURGE CAL
         REF      CNMPROC4#         ENTRY PT TO PROCESS M:DFLST CAL
         REF      TQUEUE#           ENTRY PT TO PROCESS M:QUEUE CAL
         REF      ECBCHECK          ENTRY PT TO PROCESS M:CHECKECB CAL
         REF      T:ASI#            ENTRY POINT FOR ASSOCIATE-
*                                   SUSPENDED IMAGE CAL.
         REF      T:COUPL#          ENTRY POINT FOR M:COUPLE,DECOUPLE
         REF      T:FSI#            ENTRY POINT FOR FIND SUSPENDED
*                                   IMAGE CAL.
         REF      LDLNK#            ENTRY POINT FOR M:LINK,M:LDTRC
         SPACE    2
         SREF     TTP               A NON ZERO VALUE IN TP SYSTEMS
         SREF     T:GETID           ROUTINE TO GET UNIQUE ID FOR TP
         REF      T:INITJOB         ROUTINE TO PROCESS INITIATE GJOB CAL
         REF      T:PAC             ROUTINE TO LOAD AC REGS FOR SPECIAL
*,*                                 SHARED PROCESSORS
         REF      T:IACU            RTN TO VALIDATE ACCESS PROTECTION
         REF      T:SSEM            EXIT RETURN TO SCHEDULE USER
         REF      T:REG             EXIT TO REPORT EVENT (E:AP) FOR CORE
*,*                                 LIBRARY  AND BLOCK USER
         REF      TRAPEXIT          EXIT TO SCHED AT END OF CAL PROCESS.
*,*                                 TO CAUSE PSD TO BE BUMPED BY 1
         REF      T:SELFDESTRUCT    FOR ZAPPING OVERLAY
         SREF     RTALTCP           ENTRY FOR PROCESSING REAL TIME CALS
*,*                                 (CAL1,5 TYPES)
         SREF     RTINTRTN          ENTRY TO PROCESS M:INTRTN CAL
*,*                                 (CAL1,9 REAL TIME CALS)
         REF      MAPBUFS
         REF      TRNC              ENTRY PT TO PROCESS TRUNC CALS
         REF      T:GBUF            ROUTINE TO GET SPARE BUFFER PAGE AND
*,*                                 MAP INTO SPECIFIED WINDOW PAGE
         REF      T:RBUF            ROUTINE TO RELEASE SPARE  BUFFER
*,*                                 PAGE AND RETURN TO FREE BUFFER POOL
*,*                                 OR MONITOR
         REF      XCONSETUP         EXIT TO HONOR EXIT CONTROL ADDRESS
         REF      T:UTSXTS          RTN TO COPY TSTACK
*,*                                 TO USER'S TEMP STACK
         REF      T:PROCOV          RTN TO LOAD SHARED PROCESSOR OVERLAY
         REF      CHKPROT           RTN TO CHECK ACCESS PROTECT ON PG
         REF      DELTAGO           EXIT TO GO TO DELTA
         REF      ABORT             SUA 7E-XX (XX IN R6)
         REF      SCR61             SUA 61-XX (XX IN R6)
         SPACE 5
*
*        REFS
*                 GENERAL DATA
*
         REF      QUEUE             ADDRESS OF ENTRY TO IOQ WITH DCB
*,*                                 AND NO END ACTION
         REF      QUEUE1            ADDRESS OF ENTRY TO IOQ WITH DCB
*,*                                 AND END ACTION
         REF      NEWQ              ADDRESS OF ENTRY TO IOQ WITH NO DCB
         REF      S:RTCORE          TOTAL # LOCK IN CORE PAGES
*,*                                 AS RESULT OF M:HOLD CALS
         REF      SPDBASE           SPECIAL SHARED PROC DATA BIAS
         REF      SPPBASE           SPECIAL SHARED PROC PROCEDURE BIAS
         REF      P:NAME            PROCESSOR NAME TABLE
         REF      PB:LNK            PROCESSOR # OF NEXT OVERLAY
         REF      PB:LCT            # RT USERS ASSOC WITH PROC
*,*                                 THAT ARE LOCKED IN CORE
         REF      PB:PSZ            PROC PURE PROCEDURE SIZE IN PGS
         REF      PB:UC             #USERS IN CORE ASSOC. WITH PROCESSOR
         REF      S:CUN             CURRENT USER
         REF      UH:FLG            USER FLAGS
         REF      UH:FLG2           MORE USER FLAGS
         REF      UB:ASP            PROC # OF SPECIAL SHARED PROCESSOR
         REF      UB:DB             PROC # OF DEBUGGER ASSOC WITH USER
         REF      UB:APR            PROC # OF PROC ASSOC WITH USER
         REF      SB:RTY            DCT4 ENTRY FOR RAT TABLES
         REF      SV:RSIZ           LENGTH OF RAT TABLES
         REF      SH:RBCU           BATCH CURRENT ALLOCATED RATS
         REF      SH:RNM            RESOURCE NAME TABLE
         REF      J:JIT             THE JIT
         REF      JB:PRIV           PRIVILEGE LEVEL OF USER (BITS0-7)
         REF      JB:MAX            MAX # OF RESOURCES
         REF      JB:CUR            CURRENTLY ALLOCATED RESOURCES
         REF      J:BASE            TEMP STORAGE AREA
         REF      J:PLL             PG# - LOWER LIMIT OF PURE PROCEDURE
         REF      J:TCB             TASK CONTROL BLOCK
         REF      J:USENT           ADDRESS OF USER TRAP CONTROL ROUTINE
*,*                                 (BITS 15-31) FLAGS IN BITS 1-7
         REF      USRENT            DISPLACEMENT INTO JIT FOR J:USENT
         REF      TRPFLAGS          BITS 1-7 OF J:USENT
         REF      TRAPFLGB          BIT OF TRPFLAGS FROM RIGHT
         REF      J:EXTENT          ADDRESS OF USER EXIT CONTROL ROUTINE
         REF      J:ALB             LAST BRANCH ADDRESS (560 ONLY)
         REF      JB:STEPCC         STEP CC FOR CURRENT JOB STEP
         REF      JBFBFP            FILE MGMT FREE BUFFER POOL HEAD
         REF      J:DCBLINK         DCB NAME TABLE
         REF      J:RNST            RUN STATUS FOR USER
         REF      J:ABC             BITS 0-7 I/O ABORT CODE
         REF      J:TELFLGS         FLAGS USED BY TEL AND CCI
         REF      J:UPRIV           USER'S PRIVILEGE BITS
         REF      PR:MS             M:SYS/M:MASTER PRIVILEGE BIT
         REF      ERO               I/O ERROR OVERRIDE ADDRESS
         REF      M:XX              ADDRESS OF M:XX DCB
         REF      S:MBSF            START MBS FLAG
         REF      E:AP              ASSOCIATE PROCESSOR EVENT
*,*                                 ( FOR CORE LIBRARY )
         REF      RTICBHDR          PTR TO HEAD OF AVAILABLE ICBS
         REF      C:ETM             EXECUTION TIME MULTIPLIER
         REF      C:RT90            90 % RESPONSE TIME VALUE
         REF      S:CUIS            # CURRENT USERS IN SYSTEM
         REF      TEMP              TEMP CELL
         REF      YE                MASK
         REF      X1FFFE            MASK
         REF      XN2               MASK
         REF      XFF00             MASK
         REF      FF3FFFFF          MASK
         REF      Y01FE             MASK
         REF      Y003              MASK
         REF      XFFFF             MASK
         PAGE
*P*      NAME:    ALTCP
         SPACE    1
*P*      PURPOSE:
*P*               TO PROCESS CAL1,3 TO CAL1,9 REQUESTS
*P*               TRANFERRING CONTROL TO THE APPROPRIATE SERVICE
*P*               MODULE
         SPACE    1
*P*               TO PROCESS TRAPS X'40'-X'46', ILLEGAL CAL
*P*               TRAPS X'49'-X'4B' AND UNDEFINED CAL1 TRAPS
         SPACE    2
*P*      DESCRIPTION:
*P*               THERE ARE TWO LOGICALLY DISTINCT FUNCTIONS CONTAINED
*P*               WITHIN THIS MODULE
*P*               1) THE ALTERNATE CAL1 PROCESSING ENTERED AT CALCK
*P*                  WHICH PROCESSES THE CAL1,3 TO CAL1,9 REQUESTS
*P*                  AND DISPATCHES THEM TO THE APPROPRIATE MODULE
*P*               2) THE HANDLING OF TRAPS OF WHICH THERE ARE TWO MAIN
*P*                  ENTRIES:  40TRAP FOR HANDLING TRAPS X'40'-X'46'
*P*                  AND CALBAD FOR HANDLING ILLEGAL CALS X'49'-X'4B'
*P*                  AND UNDEFINED CAL1
         SPACE    1
*P*               THIS MODULE ALSO CONTAINS A NUMBER OF ROUTINES THAT
*P*               ARE CALLED FROM MULTIPLE PLACES IN THE MONITOR.
*P*               SUCH ROUTINES INCLUDE THE SET OF CAL EXIT ROUTINES
*P*               THAT EFFECT THE SETTING OF CONDITION CODES UPON RETURN
*P*               TO THE USER AT THE CAL+1. OTHER ROUTINES ARE
*P*               TMPTOSTK TO MOVE THE USER'S TEMP STACK TO THE TSTACK
*P*               AND CKLIMIT TO RETURN THE MAXIMUM PROTECTION ON
*P*               A RANGE OF MEMORY.
         SPACE    1
*P*      REFERENCE:
*P*               SEE REPORTS F AND D
         PAGE
ALTCP:   EQU      %                 MODULE START
*
*
*
XFFDF    EQU      NB31TO0+6
XFFFE    EQU      NB31TO0+1
*        REAL-TIME DATA (CAL1,5)
*
CAL3CODE EQU      6
SLAVECODE  EQU    7                 M:SLAVE FPT CODE
MASTERCODE EQU    8                 M:MASTER FPT CODE
         BOUND    8
MSCODES  DATA     SLAVECODE,MASTERCODE
OPCODES  EQU      X'10003'          MASK OF LEGAL EXU OPCODES
*
EXUCODE  EQU      X'28'             M:EXU FPT CODE
*
EXU:ERR1 DATA     X'010000B9'
EXU:ERR2 DATA     X'040000B9'
EXU:ERR3 DATA     X'050000B9'
*
*
RTERR    DATA     X'030000B8'       ABORT CODE: RESTRICTED MONITOR SERVICE
*                                   ATTEMPTED FOLLOWING M:HOLD CAL1
FLG:LIC  EQU      X'800'            UH:FLG2 MASK : LOCKED-IN-CORE BIT
OPTBL    DATA     X'00200000'       TABLE OF BITS
         DATA     X'00280000'       INDICATING WHICH OPCODES
         DATA     X'002800C0'       DELTA MAY USE
         DATA     X'00380040'       TO MODIFY PP
Y009     DATA     X'00900000'
         PAGE
*F*      NAME:    CALCK
         SPACE    1
*F*      PURPOSE:
*F*               TRANSFER VECTOR TO PROCESS CAL1S OTHER THAN
*F*               CAL1,1 OR CAL1,2.
         SPACE    1
*F*      REFERENCE:
         SPACE    1
*F*               SEE REPORT D
         SPACE    2
*D*      NAME:    CALCK
         SPACE    1
*D*      REGISTERS:
*D*               R3 = R FIELD OF CAL1
*D*               R5 = JIT ADDRESS
*D*               R6 = FIRST WORD OF FPT
*D*               R7 = ADDRESS OF FPT+1
*D*               R8 = FPT CODE FROM BYTE 0 OF FPT
*D*               R11 = EXIT ADDRESS ( USUALLY TRAPEXIT )
         SPACE    1
*D*      CALL:
*D*               B FROM CALPROC FOR ALL CAL1S EXCEPT CAL1,1 & CAL1,2
         SPACE    1
*D*      ENVIRONMENT:
*D*               MAPPED,MASTER
         SPACE    1
*D*      DESCRIPTION:
*D*               THE FIRST WORD OF THE FPT IN R6 IS STRIPPED TO THE
*D*               RIGHTMOST 24 BITS.
*D*               THE R FIELD VALUE IN R3 IS VALIDATED AND USED AS
*D*               A SWITCH TO INDIVIDUAL DECODING SUBROUTINES
*D*               FOR EACH OF THE DEFINED CAL1S, CAL1,3-4-5-6-7-8-9.
*D*               IF THE VALUE EXCEEDS THE VALID RANGE CONTROL IS
*D*               TRANSFERED TO BADCAL. IF THE VALUE IS 1 OR 2,
*D*               CONTROL IS TRANSFERED TO SUA7C TO INVOKE A SUA X'7C'.
         PAGE
CALCK    EQU      %
         AND,R6   M24
         CI,3     9                 IS IT CAL1,9?
         BE       %+2               YES..LEAVE INHIBITS FOR M:INTRTN
         ENABLE                     NO...ALLOW INTERRUPTS NOW
         INT,R3   C1TV,R3           GET XFER VECTOR
         BCS,8    0,R3              GO - IS OK FOR MULTI-PROCESSING
         BLOCK                      BLOCK USER BACK TO MASTER CPU
         B        0,R3              AND THEN DISPATCH THE CAL
*
C1TV     EQU      %
         GEN,1,31 0,BADCAL          0
         GEN,1,31 1,SUA7C           1 - SHOULDNT BE HERE FOR CAL1,1
         GEN,1,31 1,SUA7C           2 - SHOULDNT BE HERE FOR CAL1,2
         GEN,1,31 1,CAL13           3 - CAL1,3
         GEN,1,31 1,CAL14           4 - CAL1,4
         GEN,1,31 0,CAL15           5 - CAL1,5
         GEN,1,31 1,CAL16           6 - CAL1,6
         GEN,1,31 0,CAL17           7 - CAL1,7
         GEN,1,31 0,CAL18           8 - CAL1,8
         GEN,1,31 0,CAL19           9 - CAL1,9
         GEN,1,31 1,BADCAL          A - CAL1,A
         GEN,1,31 1,BADCAL          B - CAL1,B
         GEN,1,31 1,BADCAL          C - CAL1,C
         GEN,1,31 1,BADCAL          D - CAL1,D
         GEN,1,31 1,BADCAL          E - CAL1,E
         GEN,1,31 1,BADCAL          F - CAL1,F
*
*
HICAL    EQU      %-C1TV
*                 FALL INTO CAL1,9 PROCESSING
         PAGE
*                 CAL1,9 PROCESSING
*
*                 INSTRUCTION FORMAT:
*
*                      GEN,8,4,3,1,8,8
*                          | | | | | |-- EXIT TYPE (IE., 1=M:EXIT ...)
*                          | | | | |---- STEP CC'S OR REAL-TIME INT.CODE
*                          | | | |------ PRESENCE BIT FOR CODES
*                          | | |-------- ALWAYS ZERO
*                          | |---------- 9 (IE., REG. FIELD)
*                          |------------ X'04' (IE., CAL1)
*
*                 R7 LOOKS AS FOLLOWS AT THIS POINT:
*
*                           GEN,15,1,16
*                                | |  |-- IF STEP CONDITION CODES WERE
*                                | |      SPECIFIED (IE., M:EXIT/ERR/
*                                | |      XXX):
*                                | |         ADR. WITHIN TSTACK WHICH
*                                | |         WHEN REDUCED BY THE CURRENT
*                                | |         VALUE AT TSTACK AND IN-
*                                | |         CREMENTED BY 15 WILL EQUAL
*                                | |         THE VALUE OF THE ADR. FIELD
*                                | |         +1 OF THE CAL1 (WHEW)
*                                | |      IF REAL TIME CODES WERE
*                                | |      SPECIFIED (IE., M:INTRTN):
*                                | |         THE IMAGE OF BITS 16-31 OF
*                                | |         THE CAL1 INSTRUCTION
*                                | |
*                                | |----- PRESENCE BIT:
*                                |           1  IF STEP CONDITION CODES
*                                |              OR REAL TIME CODES WERE
*                                |              SPECIFIED IN THE CAL1
*                                |           0  IF NOT SPECIFIED (THIS
*                                |              WOULD BE AN ERROR
*                                |              CONDITION FOR M:INTRTN
*                                |              SINCE THE PROC ALWAYS
*                                |              SETS THIS BIT
*                                |
*                                |------- ALWAYS ZERO
*
*
*
         PAGE
CAL19    EQU      %
         LW,R4    R7                SAVE R7 FOR LATER USE
         CW,R7    Y0001             IS PRESENCE BIT SET?
         BANZ     CAL19MOD          YES; STEP CONDITION CODES OR REAL
*                                   TIME INTERRUPT CODES SPECIFIED
* TRY TO DIFFERENTIATE BETWEEN 1,2B,3B
         ENABLE                     NO...ALLOW INTERRUPTS NOW
         SW,R7    TSTACK
*        CAL1,9   EFFECTIVE ADDRESS DETERMINES THE ROUTINE
         AI,R7    15
         BLZ      SCCSTRP           NARROW DOWN LOOPHOLES
         INT,R7   R7
*
         CI,R7    16                POSSIBLE LOOP HOLES HERE
         BG       SCCSTRP
         CI,R7    0
         BE       SCCSTRP
         LW,R4    R7                SET UP FOR MTRTN
         CI,R7    NC19S+1
         BGE      C19TV
         EXU      C19TV-1,R7
MONOVLY  EQU      %
         LI,2     MISOVSEG
         B        T:OVERLAY
C19TV    EQU      %
         B        BADCAL
         B        T:EXIT            M:EXIT
         B        T:ERROR           M:ERROR
         B        T:ABORT           M:ABORT
         LI,R0    MSTRAP#
         B        MTRTN
         B        CALMUL2           COOP SUPER CLOSE
         B        BADCAL            M:CLEAT
         B        BADCAL            M:TERM
         B        BADCAL
         B        BADCAL            M:INTRTN ILLEGAL WITH SCC BIT UNSET.
         B        MSTRUNC           M:STRUNC
NC19S    EQU      %-C19TV
         SPACE    2
INTRTN   EQU      %                 M:INTRTN (CAL1,9   X'A')
         LW,0     RTICBHDR          IS THIS A REAL TIME SYSTEM?
         BLZ      BADCAL            NO
         B        RTINTRTN          M:INTRTN ROUTINE IN RTROOT
         SPACE    2
SCCSTRP  EQU      %
         LW,R7    R4                RESTORE R7 AS OF BEF.MANIPLTN
CAL19MOD EQU      %
         AI,R7    -1                GET BACK SCC & EXIT TYPE
         AND,R7   M8                EXAMINE TYPE
         BEZ      BADCAL
         CI,R7    10                IS THIS AN M:INTRTN (REAL TIME)?
         BE       INTRTN            YES
         ENABLE                     ALLOW INTERRUPTS NOW
         CI,R7    5                 HAVE TO TAKE OF M:TRTN
         BE       MTRTN
         CI,R7    3                 NO MOD. AS SUCH ON M:STRAP
         BG       BADCAL            AND SUPERCLOSE AS YET
*  NOTE:SET STCC IS ONLY VALID FOR M:EXIT,M:ERR,M:XXX
         LW,R1    R4
         AND,R1   Y0001
         BCR,2    C19TV,R7          BIT 15 NOT SET;GO EXIT
         SLS,R1   8
         STS,R1   J:EXTENT          STCC BIT SET IN JIT
         LI,R1    1
         SLS,R4   -8
         STB,R4   JB:STEPCC,R1      SET STCC CODE IN JIT
         B        C19TV,R7          NOW GO EXIT
         PAGE
*F*      NAME:    MSTRUNC
*F*      PURPOSE: MSTRUNC PERFORMS THE 'SUPER-TRUNC' FUNCTION.
*F*               I.E., IT TRUNCATES (M:TRUNC) ALL DCBS FOR A USER.
*F*               IT THEN RELEASES ALL PHYSICAL PAGES BEING HELD AS
*F*               SPARE (FREE) DCB BLOCKING BUFFER PAGES.
*F*               SUPER-TRUNC IS USED AS A CAL (CAL1,9 11) BY USER
*F*               PROGRAMS TO REDUCE THEIR SWAP IMAGE SIZE, AND
*F*               IS USED BY THE INTERNAL MONITOR TO CLEAN UP THE
*F*               BLOCKING-BUFFER AREA WHEN A STREAM NEEDS A PAGE.
*F*
MSTRUNC  EQU      %                 M:STRUNC (CAL1,9 X'B')***********
         LW,R9    R11                SAVE RETURN (USUALLY TRAPEXIT)
         LI,R7    J:DCBLINK-1       PREPARE TO M:TRUNC ALL DCBS,
         LI,R6    M:XX                INCLUDING M:XX.
MTCNDCB  BAL,R0   MAPBUFS           GET THIS DCB'S BUFFERS INTO MAP.
         BAL,R11  TRNC              M:TRUNC THIS DCB'S BUFFERS.
MTCNBLK  AI,R7    1                 R7=> NEXT DCBNAME.
         LB,R8    *R7               R8= DCBNAME'S TEXTC LENGTH.
         BEZ      MTCNOMOR          ---> NO MORE DCBS IN THIS BLOCK.
         SLS,R8   -2                R8= DCBNAME'S WORD LENGTH - 1.
         AW,R7    R8
         AI,R7    1                 R7=> NEXT DCB ADDRESS.
         LW,R6    0,R7              R6= DCB'S ADDRESS.
         B        MTCNDCB           ---> GO TRUNC THE DCB.
MTCNOMOR LW,R7    0,R7              R7= 0 OR NEXT-BLOCK ADDRESS.
         BNEZ     MTCNBLK           ---> MORE BLOCKS; GO DO THEM.
*
MTCFREEB LI,R7    JBFBFP            PREPARE TO DISCARD FREE BUF PAGES.
         MTB,0    J:JIT,R7          ARE THERE ANY MORE FREE...
         BEZ      *R9               ---> NO. RETURN (TO TRAPEXIT) --->
         LI,R14   BUFF1             YES. USE BUFF1 PAGE (NOW EMPTY)
         BAL,R2   T:GBUF              TO MAP A FREE BUFFER PAGE.
         LI,R5    0                 NOW FREE THE PHYSICAL PAGE
         BAL,R2   T:RBUF              AND UNMAP THE BUF.
         B        MTCFREEB          ---> FREE ALL FREE BUF PAGES.
         PAGE
*
*        CAL1,3  DEBUGGING CALLS.  ALL HANDLED BY DEBUG OVERLAY.
*
CAL13    OVERTO   DEBUGSEG,0
         PAGE
CAL14    EQU      %
         CI,8     NC14S
         BGE      BADCAL
*
         LI,1     C14TV
         EXU      *8,1
         B        MONOVLY
C14TV    EQU      %
         B        BADCAL            0
         B        BADCAL            1
         LI,R0    T:SAVEGET#        2
         LI,R0    T:SAVEGET#        3
         LI,R0    T:ASSOCIATE#      ASSOC  LIB/DEBUG
         LI,R0    T:DISASSOCIATE#   DISASSOC LIB/DEBUG
         B        T:CLRERR          8='06'
NC14S    EQU      %-C14TV
         PAGE
CAL15    EQU      %
         CI,8     EXUCODE           IS THIS M:EXU?
         BE       MEXU              YES
         CLM,8    MSCODES           M:MASTER/M:SLAVE?
         BCR,9    MSTRSLV           YES
         CI,8     CAL3CODE          IS THIS M:CAL
         BE       MCAL3             B/YES, GO TO IT.
         LW,0     RTICBHDR          IS THIS A REAL-TIME SYSTEM?
         BLZ      BADCAL            NO
         B        RTALTCP           CAL15 HANDLER IN RTROOT MODULE
*
MEXU     EQU      %                 M:EXU CAL1,5 RECEIVER
*
*        EXECUTE THE FOLLOWING PRIVILEGED INSTRUCTIONS:
*
*                 SIO = X'4C'
*                 TIO = X'4D'
*                 TDV = X'4E'
*                 HIO = X'4F'
*                 RD  = X'6C'
*                 WD  = X'6D'
*
*        CONDITION CODES RETURNED TO USER ARE THOSE OF THE EXECUTED
*        INSTRUCTION; HENCE, ANY ABNORMAL CONDITION IS REPORTED AS
*        AN ABORT (CODE = B9; SUBCODES, AS INDICATED)
*
*        R6 = ADDRESS OF INSTRUCTION TO BE EXECUTED
*        R11 CONTAINS RETURN ADDRESS (TRAPEXIT)
*
         LI,R0    X'C0'
         CB,R0    JB:PRIV           PRIVILEGE OK?
         BLE      EXUOK             YES
         LW,14    EXU:ERR1          NO; ABORT USER (B9/01)
         B        CALBAD
*
EXUOK    CI,R6    X'1FFF0'          CHECK FOR INSTRUCTION IN REGISTER
         BANZ     EXU15             NO
         AW,R6    J:BASE            CONVERT TO STACK ADR.
         B        EXU17             CONTINUE
EXU15    LW,R7    R6                GET INSTRUCTION ADR.
         SLS,R7   -9                CONVERT TO PAGE ADR.
         BAL,11   T:IACU            CHECK PROTECTION
         BCR,2    EXU17             00 OR 01
         LW,14    EXU:ERR2          10 OR 11; ABORT USER (B9/04)
         B        CALBAD
EXU17    LB,R7    *R6               GET OPCODE
         AND,R7   M7                SCRUB INDIRECT BIT
         SLS,R7   -1                DIVIDE BY TWO
         AI,R7    -X'26'            SUBTRACT BASE VALUE
         BGEZ     EXU19             CHECK LEGAL OPCODES
EXU18    LW,14    EXU:ERR3          BAD OPCODE; ABORT USER (B9/05)
         B        CALBAD
EXU19    LW,9     X1,R7             CHECK FOR LEGAL OPCODES
         CI,9     OPCODES           MASK OF LEGAL OPCODES
         BAZ      EXU18             ILLEGAL OPCODE
         STW,R6   J:BASE+1          SAVE INSTRUCTION LOC
         LW,R2    TSTACK
         AI,R2    -15               POINT TO REGISTER 0 IN STACK
         STW,R2   J:BASE+3          SAVE POINTER TO REGISTERS
         AI,R2    -2                POINT TO PSD
         AND,R2   XN2                            IN STACK
         STW,R2   J:BASE+2          SAVE POINTER
         LCI      0                 RESTORE USER REGISTERS
         LM,0     *J:BASE+3             FROM STACK ENVIRONMENT
         LCF      *J:BASE+2         CC'S TOO
         EXU,0    *J:BASE+1         ***********************************
         STCF     *J:BASE+2         SAVE CC'S
         LCI      0                 PUT REGS BACK IN USER ENVIRONMENT
         STM,0    *J:BASE+3
         B        TRAPEXIT          RETURN TO USER VIA TRAPEXIT
*
MSTRSLV  EQU      %                 M:MASTER/M:SLAVE CAL1,5 RECEIVER
*
*        PLACE USER PROGRAM IN MASTER (PROTECTED ON SIGMA9/X560) MODE
*        OR RETURN TO SLAVE MODE
*
*        R8 = FPT CODE
*        R11 CONTAINS RETURN ADDRESS (TRAPEXIT)
*
         LW,R0    PR:MS             'X' PRIV FLAG
         CW,R0    J:UPRIV           BYPASS JB:PRIV CHECK
         BANZ     MSXFLG               FOR PRIVILEGED PROC.
         LI,R0    X'C0'             SECURITY CHECK
         CB,R0    JB:PRIV
         BG       CC1SET            NO
MSXFLG   EQU      %
         AI,8     -SLAVECODE        R8=0 IF SLAVE;1 IF MASTER
         LW,R1    8                 MOVE TO INDEX REGISTER
         LW,9     Y008              MASK FOR SLAVE BIT
         LW,R2    TSTACK            FORM POINTER TO PSD
         AI,R2    -17
         AND,R2   XN2               POINT TO PSW1
         LW,8     Y008,R1           SET SLAVE BIT IF M:SLAVE
         STS,8    0,R2              MERGE IN PSD
         LW,8     Y004,R1           SET MODE ALTERED BIT(MASTER PROTECTED)
         BIF,S9S7 MS1               X560 CHECK REQUIRED FOR MA BIT
         SLD,8    -21               SHIFT IF X560
MS1      STS,8    1,R2              MERGE INTO PSD
         LW,9     Y1                SET WRITE KEY
         LW,8     Y08,R1
         STS,8    1,R2              INTO PSD
         B        CC0RST            RETURN
         PAGE
*
*        CAL1,6   UTS RELIALIBITY CALS
*
CAL16    EQU      %
         CI,8     NC16S             CHECK IF LEGAL CAL1,6
         BGE      BADCAL            BRANCH IF NO
*
         AI,8     C16TV
         EXU      *8
         LI,1     X'A0'             DIAGNOSTIC & RELIAVILITY PRIVILEGE
         CB,1     JB:PRIV           CHECK USERS PRIVILEGE LEVEL
         BG       CAL16Y
CAL16X   EQU      %
         LI,2     RMAOVSEG
         B        T:OVERLAY
*
CAL16Y   EQU      %
         LW,1     S:CUN
         LH,1     UH:FLG,1
         CI,1     TIC
         BANZ     CAL16X
         B        CC1SET            SET CC1 FOR ERROR
*
C16TV    EQU      %
         LI,R0    T:RDERLOG#        0 READ ERROR LOG
         LI,R0    T:WTERLOG#        1 WRITE ERROR LOG
         LI,0     T:MAP#            2 CONVERT ADDRESS, M:MAP
         LI,0     T:BLIST#          3 M:SIO, SANE ENTRY AS M:BLIST
         LI,0     T:LOCK#           4 M:LOCK
         LI,0     T:DOPEN#          5 DIAGNOSTIC OPEN
         B        T:INITJOB         6 INITIATE A GHOST JOB
         LI,0     T:DCLOSE#         7 DIAGNOSTIC CLOSE
         B        T:SYS             8
         LI,0     T:BLIST#          9 BUILD COMMAND LIST
         LI,R0    T:MODPRTRT#       10(A) PROCESS M:DMOD#,M:DPART,M:DRET
         B        SETCPU#           11(B) SET CPU # TO RUN ON
NC16S    EQU      %-C16TV
         PAGE
*
*        CAL1,6 WITH FPT CODE OF X'0B' WILL SET THE SLAVE CPU #
*        THAT YOU WANT TO RUN ON IF NON-ZERO OR IF ZERO SAYS TO
*        GIVE YOU ANY CPU TO RUN ON.
*
SETCPU#  EQU      %
         LI,R7    X'F'
         AND,R7   R6                GET CPU # FROM PLIST WORD 0
         CI,R7    NSCPU             CHECK FOR LEGAL
         BG       BADCAL            NOPE->
         LI,R8    NSCPU             IS MULTI-PROCESSING SYSTEM
         BEZ      TRAPEXIT          NOPE->
         LW,R4    S:CUN             GET HIS USER #
         STB,R7   UB:CALR,R4        PUT CPU PREFERENCE AWAY
         B        TRAPEXIT          AND GO BACK TO USER
         PAGE
*****
*
*        THE REGISTER SETUP AT LOCATION CAL17 IS AS FOLLOWS:
*
*        (R6)=    DCB ADDRESS OR LINE ID ADDRESS
*        (R7)=    WA(FPT+1)
*        (SR1)=   FPT CODE
*        (SR4)=   WA(TRAPEXIT)
*
CAL17    EQU      %
         CI,SR1   C17TVEND          DO WE HAVE A LEGAL CODE
         BGE      BADCAL            GUESS NOT
         LI,R1    C17TV             GET TOP OF TRANSFER TABLE
         EXU      *SR1,R1           EXECUTE TABLE INSTRUCTION
         LI,R2    TTP               CK IF THIS IS A TP SYSTEM
         BEZ      BADCAL            B, IF NOT; CAL IS A BADDY
         LW,R2    R0                CK IF THIS IS AN M:GETID CAL
         BLZ      T:GETID           B, IF SO, AND GO DO IT
         LI,R2    TQOV2SEG          ASSUME TQ2 OVERLAY IS NEEDED
         CI,SR1   TQOV2END          BUT CHECK ON THIS
         BL       %+2               B, IF RIGHT
         LI,R2    TQOV1SEG          ELSE, LOAD SEG# FOR TQ1 OVERLAY
         B        T:OVERLAY         AND GO TO IT
*
C17TV    EQU      %
         LI,R0    CNMPROC0#         X'00'  M:GETLINE
         LI,R0    CNMPROC1#         X'01'  M:RLSLINE
         LI,R0    CNMPROC2#         X'02'  M:BUFSTAT
         LI,R0    CNMPROC3#         X'03'  M:PURGE
         LI,R0    CNMPROC4#         X'04'  M:MDFLST
         B        ECBCHECK          X'05'  M:ECBCHECK
*
TQOV2END EQU      %-C17TV
         LI,R0    TQUEUE#           X'06'  M:QUEUE  UNLOCK
         LI,R0    TQUEUE#           X'07'  M:QUEUE  DEFINELIST
         LI,R0    TQUEUE#           X'08'  M:QUEUE  PUT
         LI,R0    TQUEUE#           X'09'  M:QUEUE  GET
         LI,R0    TQUEUE#           X'0A'  M:QUEUE  STATS
         LI,R0    TQUEUE#           X'0B'  M:QUEUE  PURGE
         LI,R0    TQUEUE#           X'0C'  M:QUEUE  LOCK
         LI,R0    -1                X'0D'  M:GETID
*
C17TVEND EQU      %-C17TV
         PAGE
************************************************************************
*
*  CAL1,8 HANDLER
*
*  INPUT:
*     SR1         FPT CODE (RIGHT JUSTIFIED)
*
*  OUTPUT:
*     R0          OVERLAY TRANSFER VECTOR INDEX IF ROUTINE IS OVERLAYED
*
*  ENTRY POINTS:
*     CAL18
*
*  EXITS:
*     TO MONOVLY IF ROUTINE IS OVERLAYED
*     TO BADCAL IF FPT CODE IS INVALID
*     TO THE SPECIFIED ROUTINE IF NONE OF ABOVE.
*
*  REGISTERS DESTROYED:
*     R1
*
*  NOTE:
*     SR4 CONTAINS THE ADDRESS OF TRAPEXIT (WAS LOADED IN CALPROC).
*
************************************************************************
CAL18    CI,SR1   HICAL18           C/FPT CODE W/HIGHEST LEGAL CODE
         BLE      C18A              BLE; FPT CODE PROBABLY LEGAL
C18TV    B        BADCAL            X'00'  NON-EXISTENT
         B        MSEGLD            X'01'  M:SEGLD
         B        MLNK              X'02'  M:LINK
         B        MLNK              X'03'  M:LDTRC
         B        T:GVP             X'04'  M:GVP
         B        T:FVP             X'05'  M:FVP
         LI,R0    T:CHTBL#          X'06'  M:CT
         B        T:SAD             X'07'  M:CVM
         B        T:GDP             X'08'  M:GP
         B        T:FDP             X'09'  M:FP
         B        T:SMP             X'0A'  M:SMPRT
         B        T:GL              X'0B'  M:GL
         B        T:GCP             X'0C'  M:GCP
         B        T:FCP             X'0D'  M:FCP
         LI,R0    MINT#             X'0E'  M:INT
         LI,R0    T:WAIT#           X'0F'  M:WAIT
         LI,R0    MTIME#            X'10'  M:TIME
         LI,R0    MSTIMER#          X'11'  M:STIMER
         LI,R0    MTTIMER#          X'12'  M:TTIMER
         B        T:SYSLOAD         X'13'  M:DISPLAY
         B        MTRAP             X'14'  M:TRAP
         B        RESOURCE          X'15'  SET RESOURCE
         B        RESOURCE          X'15'  SET RESOURCE
         B        RESOURCE          X'15'  SET RESOURCE
         B        RESOURCE          X'15'  SET RESOURCE
         LI,R0    MXCON#            X'19'  M:XCON
         B        CALMUL1           X'1A'  M:LDEV
         LI,R0    T:GDDL#           X'1B'  M:GDDL
         B        MFSI              X'1C' M:ASI OR M:FSI
         B        MCOUPLE           X'1D' M:COUPLE OR M:DECOUPLE
HICAL18  EQU      %-C18TV-1         HIGHEST LEGAL FPT CODE FOR CAL1,8
*
C18A     LI,R1    C18TV             L/ADDRESS OF CAL1,8 TRANSFER VECTOR
         EXU      *SR1,R1           EXECUTE INSTRUCTION IN TV
         B        MONOVLY           B; R0 = MISOV (UCAL) OVERLAY TV INDEX
*
*
CALMUL1  LI,R0    LDEV#
         LI,11    CC1RST
         B        %+2
CALMUL2  LI,0     CCLOSE#
         LI,2     MULSEG
         B        T:OVERLAY
         PAGE
T:CLRERR EQU      %
         LW,4     S:CUN
         LH,4     UH:FLG,4
         CI,4     TIC               COMMAND PROCESSOR REQUEST
         BAZ      CC1SET            NOPE,ERROR
         LI,2     0                 YES, CLEAR
         STB,2    J:RNST             THE RUN STATUS
         STB,2    J:ABC               THE ABORT CODE
         LI,3     X'1FFFF'          L/M17 MASK
         STS,2    J:JIT+ERO         CLEAR ERROR AND ERO FIELDS IN JIT
         LI,3     2                 AS WELL AS THE BREAK BIT
         STS,2    J:TELFLGS          IN J:TELFLGS
         B        OKOUT
         PAGE
SUA7C    SUA      X'7C'
         SPACE    5
***********************************************************
         SPACE    1
*S*      SCREECH CODE:    7C
         SPACE    1
*S*      REPORTED BY:  ALTCP
         SPACE    1
*S*      MESSAGE:  ALTCP CALLED TO SERVICE A CAL THAT DOESN'T BELONG
*S*                TO ALTCP.
         SPACE    1
*S*      TYPE:  SUA
         SPACE    1
*S*      REGISTERS:
*S*               R3 = R FIELD OF CAL
*S*               R6 = FIRST WORD OF FPT
*S*               R7 = ADDRESS OF FPT+1
*S*               R8 = FPT CODE
*S*               R11 = EXIT ADDRESS (USUALLY TRAPEXIT)
         SPACE    1
*S*      REMARKS:  A CAL1,1 OR CAL1,2 HAS BEEN PASSED TO ALTCP THAT
*S*                SHOULD HAVE BEEN PROCESSED BY CALPROC.
         SPACE    1
**********************************************************
         PAGE
         PAGE
RESOURCE EQU      %
         LI,R1    SV:RSIZ           SIZE OF RAT TABLES
         CI,R6    X'C000'           TEXT RESOURCE NAME SPECIFIED
         BAZ      KRD5              NO-ASSUME DEVICE TYPE CODE
         LI,R7    X'FFFF'
KRD4     LH,R2    SH:RNM,R1
         CS,R6    R2                RESOURCE NAME FOUND IN RAT TABLE
         BE       KRD2              YES
         BDR,R1   KRD4
         B        CC3SET            ERROR-CANT FIND NAME
KRD5     CB,R6    SB:RTY,R1         DEVELOP RATX BY MATCH OF TYPE CODE
         BE       KRD2              RRTX
         BDR,R1   %-2
         B        CC3SET            ERROR-BAD TYPE  CODE
KRD2     LI,R2    SR1
         LW,SR1   *J:BASE,R2        GET USERS SR1-NUMBER TO RELEASE
         BL       CC1SET            DO NOT ALLOW NEG. SPECIFICATION
         LH,R2    SH:RNM,R1         RESOURCE NAME
         AND,R2   XFFFF
         LW,R3    SR1               SAVE NL
         CI,R2    'CO'              CORE RESOURCE
         BNE      KRD1              NO
         CI,SR1   1                 YES-EVEN NUMBER OF PAGES SPECIFIED
         BANZ     CC2SET            NO-ERROR
         SLS,R3   -1                K
KRD1     LB,R2    JB:MAX,R1         MAXIMUM PERMITTED THIS USER
         SW,R2    SR1               SUBTRACT NUMBER TO BE RELEASED
         BLZ      CC1SET            ERROR-RELEASED MORE THAN OWNED
         CB,R2    JB:CUR,R1         NUMBER CURRENTLY IN USE
         BL       CC1SET            ERROR-MAXIMUM EXCEEDED
         STB,R2   JB:MAX,R1         REDUCE NUMBER PERMITTED THIS JOB
         LC       J:JIT
         BCS,12   CC1RST            0=BATCH,1=GHOST,2=ONLINE
         LH,R2    SH:RBCU,R1        REDUCE NUMBER CURRENTLY ALLOCATED
         AND,R2   XFFFF
         SW,R2    R3
         STH,R2   SH:RBCU,R1
         MTW,1    S:MBSF            START THE MBS
OKOUT    EQU      %
CC0RST   EQU      %
CC1RST   EQU      %
         LI,12    0                 RESET CC1 & CC2
         B        OUT
CC3SET   LW,D1    Y2
         B        OUT
CC2SET   EQU      %
         LW,12    Y4
         B        OUT
CC1SET   LW,12    Y8
*
*  IN:  R12 CONTAINS CONDITION CODES IN FIRST 4 BITS
*
OUT      EQU      %
         LW,13    YE                RESET CC1,CC2,CC3
         LI,1     -17               L/WD FROM TOP OF TSTACK TO PSD
         AW,1     TSTACK            G/ADR OF PSD IN TSTACK
         AND,1    X1FFFE            BOUND 8
         STS,12   0,1               S/CC'S INTO PSD
         DESTRUCT TRAPEXIT
*
*
         PAGE
         PAGE
MTRTN    RES      0
         LI,6     T:SSEM            RETURN
* UPON ENTRY FROM ALTCP,R4 HAS BEEN SET UP TO CONTAIN
*  INFO. AS TO WHETHER IT IS A XCON RETURN
*
         AND,R4   XFF00
         BEZ      MTRTN0            NOT A XCON RETURN
         LB,R1    J:EXTENT
         CI,R1    X'20'             SEE IF XCON HAS BEEN IN PROG.
         BAZ      CC1SET            NO;RETURN TO CAL+1 WITH CC1 SET
         AND,R1   XFFDF
         STB,R1   J:EXTENT          RESET THE XIT-IN-PROG. BIT
         B        TMPTOSTK          GO MOVE TRAPPED ENVIR.TO TSTACK
MTRTN0   RES      0
         LW,1     S:CUN
         LH,3     UH:FLG,1
         CI,3     DIC
         BAZ      TMPTOSTK
         LI,5     SPDBASE           DEBUG STACK
         AI,3     -DIC              RESET DELTA IN CONTROL
         STH,3    UH:FLG,1
         LB,2     UB:ASP,1          CORE LIBRARY ASSSOC?
         BEZ      TMPTOSTK+1        NO
         AND,3    XFFFE             RESET READY TO RUN
         STH,3    UH:FLG,1
         LB,4     UB:DB,1
         MTB,-1   PB:UC,4           DEBUG DOWN
         LH,14    UH:FLG2,1
         CI,14    X'800'            LOCKED IN CORE
         BAZ      MTRTN0A           NO
         MTB,-1   PB:LCT,4          DECREMENT LOCK COUNT
         BG       MTRTN0A           STILL LOCKED
         LB,4     PB:PSZ,4          UNLOCKED, THEN
         LCW,4    4                 DECREMENT RTCORE
         AWM,4    S:RTCORE          BY PSZ
MTRTN0A  MTB,1    PB:UC,2           CORE LIBRARY UP
         LI,6     E:AP
         BAL,11   T:REG             GET THE LIBRARY
         CI,14    X'800'
         BAZ      MTRTN0B           NOT LOCKED
         MTB,0    PB:LCT,2
         BG       %+3               ALREADY ACCOUNTED FOR
         LB,14    PB:PSZ,2
         AWM,14   S:RTCORE          ADD IT IN
         MTB,1    PB:LCT,2          BUMP LCT
MTRTN0B  LI,6     T:SSEM
         B        TMPTOSTK+1
         SPACE    4
TMPTOSTK RES      0
         LW,5     J:TCB             USER TEMP STK
         LI,4     T:ABORTM
         LW,14    =X'010000A3'      ERROR CODE
         LW,3     5
         BAL,7    CHKPROT-1
         INT,3    1,5
         AND,3    M15               SCRUB WORD TRAP MASK
         AI,3     -20
         BLZ      T:ABORTM
         LW,3     0,5
         BAL,7    CHKPROT
         LW,3     0,5
         CI,5     1                 ENV. END ON AN ODD LOCATION?
         BANZ     T:ABORTM          IF SO IT'S BAD
         AI,3     -19
         AW,3     0,3
         BAL,7    CHKPROT
         LW,4     0,5
*MOVE ENVIRONMENT FROM USER'S STACK TO TSTACK
         LI,3     -9
         LD,8     *4,3              TRAP PSD
         AND,R9   =X'F0800004'      WK/MA(S9)/MA(X560) MASK
         LI,R3    -17
         AW,R3    TSTACK            PSD LOC IN TSTACK
         LD,10    *3
         LW,R11   R9                GET CORRECT PSD1
         LW,9     FF3FFFFF
         LW,R7    PR:MS             IS THIS PROGRAM/PROCESSOR AUTHORIZED
         CW,R7    J:UPRIV           FOR MASTER MODE?
         BANZ     %+5               IF SO, SKIP JB:PRIV TEST
         LB,R7    JB:PRIV           CHECK PRIV
         CI,R7    X'C0'             PERMIT C0 USER TO
         BL       %+2               CONTROL SLAVE BIT IN PSD
         OR,9     Y008              SET MASK BIT FOR SLAVE BIT
         STS,8    10
         AND,11   =X'F8FFFFFF'      TURN OFF INHIBITS JUST IN CASE
         STD,10   *3
         LCI      8
         LM,7     -8,4
         STM,7    10,3
         LM,7     -16,4
         STM,7    2,3
         LW,14    =X'010000A3'      IN CASE WE ABORT
         LW,7     -19,4             STACK BALANCE WORD
         BEZ      %+3               ZERO OK
         CI,7     -1                AS IS MINUS ONE
         BNE      T:ABORTM
         AI,7     -20
         LI,4     2
         LH,8     *5,4              SPACE COUNT
         AND,8    M15               SCRUB SPACE TRAP MASK
         SW,8     7
         CI,8     X'7FFF'
         BG       T:ABORTM
         MSP,7    *5
         LW,7     1                 FOR MSTRAP
         LW,11    6                 RETURN
         B        T:PAC
         PAGE
*
MSTRAPXIT EQU     %
*EXIT ROUTINE FOR MSTRAP
         BAL,11   T:SELFDESTRUCT    ZAP MISOV
         LW,2     TSTACK
         AI,2     -17               POINT TO PSD
         LD,0     *2                GET IT
         WD,0     X'37'             DISABLE
         STD,0    *7                FAKE OUT ENTRY
         LW,3     2,7               GET HANDLER ADDRESS
         STW,3    TEMP              SAVE IT
         LI,4     -19
         MSP,4    TSTACK            EMPTY STACK
         LCI      0
         LM,0     2,2               LOAD REGISTERS
         B        *TEMP
*
40TRAP   EQU      %
         ENABLE                     *** OK TO LET 'EM COME NOW.
         LI,R7    X'FF'             MASK TO STORE TRAP CELL SUB CODE
         CW,0     Y004              WAS TRAPPING USER UNMAPPED...
         BAZ      ABORT             ---> YES. SCREECH.
         CW,0     Y008              WAS TRAPPING USER MASTER MODE...
         BANZ     TRAP10            ---> NO.
         LW,R2    PR:MS
         CW,R2    J:UPRIV           CAN USER GO MASTER MODE??
         BANZ     %+4               B/YES, SKIP JB:PRIV CHECK.
         LB,2     JB:PRIV           GET USER PRIV
         CI,2     X'C0'             CAN HE BE MASTER MODE
         BL       ABORT             NO, SCREECH
         AND,0    M17               SCRUB ADDRESS
         CI,0     X'A000'           CHECK FOR USER AREA
         BL       ABORT             NO, SCREECH
TRAP10   LW,4     S:CUN             R4 = CURRENT USER #.
         LH,15    UH:FLG,4          R15= FLAGS FOR THIS USER.
         CI,15    TIC+DIC+DELA      IS TEL IN CONTROL OR DELTA ASSOC.
         BAZ      TRAP40            ---> NO.
         CI,15    TIC               IS TEL IN CONTROL.
         BANZ     SCR61             ---> YES; SCREECH.
         CI,15    DIC               WAS DELTA IN CONTROL.
         BAZ      TRAP30            ---> NO.  GO TO DELTA.
*                                   YES.  SPECIAL CHECKS NEEDED.
         CB,6     Y4
         BNE      TRAP30
*
         LC       6                 CHECK TRAP TYPE-IF NOT MEM VIOL,
*                                   CANT BE PATCH TO PROCEDURE BY DELTA
         BCR,1    TRAP30             NORMAL TRAP
*
         LW,R2    *R0               EXAMINE TRAPPING INSTRUCTION
         BLZ      TRAP30            INDIRECT NOT ALLOWED
         SLD,R2   -29               SHIFT OPCODE TO FORM BIT
         SLS,R3   -27               AND WORD INDICES
         LW,R3    BT31TO0+1,R3      CHECK FOR
         CW,R3    OPTBL,R2          ALLOWED OPCODE
         BAZ      TRAP30            NO, NORMAL TRAP
         PSW,R6   TSTACK            SAVE TRAP LOC, TCC
         LW,R0    *R0               GET TRAPPING INSTRUCTION
         PSW,R0   TSTACK            AND SAVE IT
         LW,R1    TSTACK            RESTORE
         LCI      0                 DELTA'S
         LM,R0    -17,R1            REGISTERS
         ANLZ,R7  *TSTACK           GET EFFECTIVE
         STCF     R1                ADDRESS
         SLS,R1   -30               AND MAKE IT
         SLS,R7   -11,R1            A PAGE
         CLM,R7   J:PLL             IS IT PROCEDURE
         BCS,9    TRAP28            NO, NORMAL TRAP
         BAL,R11  T:IACU            CHECK ACCESS
         BCS,2    TRAP28            10,11 NORMAL TRAP
         LW,R1    TSTACK            SET UP POINTER
         AI,R1    -17               TO DELTA'S
         STW,R1   J:BASE            REGISTERS
         AI,R1    -2                AND TO
         AND,R1   NB31TO0+1         DELTA'S
         STW,R1   J:BASE+1          PSW1
         LCI      0                 RESTORE
         LM,R0    *J:BASE           DELTA'S REGISTERS
         LCF      *(J:BASE+1)       AND CC,FC
         EXU      *TSTACK           EXU DELTA'S STORE INTO PP
         STCF     *(J:BASE+1)       UPDATE CC,FC
         LCI      0                 UPDATE
         STM,R0   *J:BASE           DELTA'S REGISTERS
         BUMP     -2,1
*
         LW,1     S:CUN             * SET
         LH,2     UH:FLG,1          *     PROCEDURE
         OR,2     X10               SET PPSWAP
         STH,2    UH:FLG,1          *
         B        TRAPEXIT          GO BACK TO USER+1
*
TRAP28   RES      0
         PLW,1    TSTACK
         PLW,6    TSTACK
         LW,4     S:CUN             R4= USER# AND R15= FLAGS.
         LH,15    UH:FLG,4           (FOR DELTAGO).
*
TRAP30   LI,0     X'FF'             PREPARE TO GO TO DELTA:
         AND,0    6                 R0= TRAP ADDRESS (INTO DELTASTACK)
         LI,10    SPPBASE+X'C'      R10= DELTA ENTRY ADDRESS.
         LB,6     6
         STB,6    10                     ADD CC/FC FROM TRAP.
         B        DELTAGO         -----> GO TO DELTA.
*
TRAP40   EQU      %                 TRAP WITH DELTA NOT ASSOCIATED.
         SLS,R3   TRAPFLGB
         CW,R3    J:USENT           DOES USER HAVE TRAP CONTROL...
         BANZ     STKTOTMP          ---> YES. GO TO USER CONTROL.
         LI,14    X'F'              NO. ABORT THE USER.
         AND,14   6                 GET TRAPLOC. (X FROM 4X IN R6).
         BEZ      TRAP40A           ---> TRAP 40.
         AI,14    4                 SUBCODE FOR TRAP4X IS X+4.
         B        TRAP40B
40SUBS   GEN,8,8,8,8  0,4,3,0       SUBCODES FOR TRAP 40:
         GEN,8,8,8,8  2,4,0,0         1=NEI  2=NEM  3=PI   4=MPV
         GEN,8,8,8,8  1,0,1,0         0=IMPOSSIBLE.
         GEN,8,8,8,8  0,0,0,0
TRAP40A  LB,7     6                 SUBCODE FOR TRAP40
         SLS,7    -4                DEPENDS ON TRAPCC.
         LB,14    40SUBS,7
TRAP40B  SCS,14   -8                GET ERROR SUBCODE IN 0-7.
         AI,14    X'A4'             ADD ERROR CODE IN 24-31.
         B        T:ABORTM        -----> GO ABORT USER.
*
STKTOTMP EQU      %                 TRAP WITH TRAP CONTROL IN USER.
         LI,1     X'1FFFF'
         AND,1    J:TCB             R1 => USER TCB.
         BNEZ     STKTOT10          ---> USER HAS A TCB.
         LI,1     X'1FFFF'
         AND,1    TSTACK+5          GET TCB FROM USER R0 IF NONE YET.
         STS,1    J:TCB
STKTOT10 LI,0     X'FF'
         AND,0    6                 R0 TO USERSTACK (TRAP ADDRESS).
         LW,10    J:USENT
         LB,6     6
         STB,6    10                GO TO J:USENT WITH CC SET BY TRAP.
         LW,11    L(X'FF01FFFF')
         LI,14    X'A3'             R14= ABORT CODE IF USERSTACK BAD.
         BAL,4    T:UTSXTS          COPY TSTACK TO USER STACK.
         B        T:ABORTM          ---> USER STACK IS BAD.
         B        T:SSEM            SCHEDULE, PULL, & GO TO USER.
         PAGE
BADCAL   EQU      %                 ILLEGAL CAL1.
         LI,R14   X'AE'             R14 = ABORT CODE.
CALBAD   EQU      %
         ENABLE                     ALLOW INTERRUPTS NOW
         LI,3     X'80'
         SLS,3    TRAPFLGB
         CW,3     J:USENT
         BANZ     STKTOTMP
         B        T:ABORTM
         PAGE
*F*
*F*      NAME:    MLNK
*F*
*F*      PURPOSE: TO DRIVE TO THE LNKTRC OVERLAY TO PROCESS THE
*F*               M:LINK AND M:LDTRC CALS.
*F*
*F*      DISCRIPTION:  IF THE USER HAS ESTABLISHED EXIT CONTROL,
*F*               CONTROL TRANSFERS TO THE EXIT CONTROL LOGIC IN STEP.
*F*
*F*               OTHERWISE, OR UPON RETURN FROM THE USER'S EXIT
*F*               CONTROL LOGIC, THE LNKTRC OVERLAY IS CALLED AND
*F*               ENTERED.
*F*
*D*      NAME:    MLNK
*D*
*D*      DESCRIPTION:  IF THE USER WHO ISSUED THE M:LINK OR M:LDTRC
*D*               CAL IS A REAL-TIME USER WHO HAS LOCKED HIMSELF
*D*               IN CORE, HE IS ABORTED.
*D*
MLNK     EQU      %
         BAL,R1   RTCHK             CHECK IF THIS USER IS A REAL-TIME
*                                   USER WHO HAS LOCKED HIMSELF IN CORE
*                                   THIS ROUTINE RETURNS S:CUN IN R4
         BCS,4    RTCHKERR          YES, HE IS; ABORT HIM
*D*
*D*               IF EXIT CONTROL HAS BEEN ESTABLISHED, CONTROL
*D*               TRANSFERS TO XCONSETUP IN STEP.
*D*
         LI,1     X'1FFFF'
         CW,1     J:EXTENT
         BAZ      MLNK1
         LB,1     J:EXTENT
         CI,1     X'20'             IF EXIT CONTROL IN PROG.
         BANZ     MLNK1             PROCEED WITH  LINK/LDTRC
         OR,1     X8
         STB,1    J:EXTENT
         B        XCONSETUP         GO TO EXIT CONTROL IN STEP
*D*
*D*               OTHERWISE, OR AFTER RETURN FROM THE EXIT CONTROL
*D*               LOGIC, THE LNKTRC OVERLAY IS ENTERED.
*D*
MLNK1    RES      0
         OVERLAY  LDLNKSEG,LDLNK#
         B        TRAPEXIT
*
*        GO TO COUPLE/DECOUPLE LOGIC
*
MCOUPLE  EQU      %
         OVERLAY  LDLNKSEG,T:COUPL#
         B        TRAPEXIT
*
*        GO TO M:CAL LOGIC IN THE LNKTRC OVERLAY
*
MCAL3    EQU      %
         OVERLAY  LDLNKSEG,T:CAL#
         B        TRAPEXIT
         PAGE
*F*
*F*      NAME:    MSEGLD
*F*
*F*      PURPOSE: TO PROCESS THE M:SEGLD CAL.
*F*
*F*      DESCRIPTION:  IF THE CAL WAS ISSUED BY A USER PROGRAM,
*F*               CONTROL PASSES TO SEGLD IN THE MISOV OVERLAY.
*F*
*F*               IF ISSUED BY A SHARED PROCESSOR, CONTROL PASSES
*F*               TO THE T:PROCOV ROUTINE IN T:OV.
*F*
*D*      NAME:    MSEGLD
*D*
*D*      INPUT:   R6 = FPT WORD 0
*D*               R7 = WA(FPT WORD 1)
*D*
*D*      OUTPUT:  IF ISSUED FROM A USER PROGRAM:
*D*                   SR2 = WA(SEGMENT NAME)
*D*
*D*               IF ISSUED BY A SHARED PROCESSOR:
*D*                   R4 = INDEX TO OVERLAY IN PROCESSOR TABLES
*D*
*D*      DESCRIPTION:  IF THE M:SEGLD CAL WAS ISSUED BY A REAL-TIME
*D*               USER WHO HAS LOCKED HIMSELF IN CORE, HE IS ABORTED.
*D*
MSEGLD   EQU      %
         BAL,R1   RTCHK             CHECK IF THIS USER IS A REAL-TIME
*                                   USER WHO HAS LOCKED HIMSELF IN CORE
*                                   THIS ROUTINE RETURNS S:CUN IN R4
         BCS,4    RTCHKERR          YES, HE IS; ABORT HIM
*D*
*D*               IF THE CAL WAS ISSUED BY A USER PROGRAM, CONTROL
*D*               PASSES TO SEGLD IN THE MISOV OVERLAY.
*D*
         LW,SR2   0,R7              SR2= ADDRESS OF SEGMENT NAME.
         BGEZ     SEGLD0            ---> GOT ADDRESS DIRECTLY.
         CI,SR2   X'1FFF0'          INDIRECT ADDRESS.
         BANZ     %+2               CONVERT REGISTER ADDRESS
         AW,SR2   J:BASE            INTO STACK ADDRESS.
         LW,SR2   *SR2              GO INDIRECT.
SEGLD0   CI,SR2   X'1FFF0'          CONVERT
         BANZ     %+2               REGISTER ADDRESS
         AW,SR2   J:BASE            INTO STACK ADDRESS.
         LB,4     UB:APR,4          IS IT A SHRD PROC
         BNEZ     SEGLD1
         OVERTO   MISOVSEG,SEGLD#
*D*
*D*               IF THE CAL WAS ISSUED BY A SHARED PROCESSOR, BUT
*D*               PB:LNK (OVERLAY LINK) IS ZERO, THE PROCESSOR IS
*D*               RUNNING NON-OVERLAID AND CONTROL RETURNS TO THE
*D*               PROCESSOR.
*D*
SEGLD1   EQU      %
         LB,4     PB:LNK,4          IS THE SHARED PROCESSOR OVERLAID..
         BEZ      MSEGLDEX          ---> NO. WE'RE FINISHED.
*D*
*D*               OTHERWISE, THE SEGMENT NAME IS FOUND IN THE P:NAME
*D*               TABLE BY LINKING THROUGH PB:LINK AND THE OVERLAY IS
*D*               IS LOADED VIA THE T:PROCOV IN T:OV.  IF THE SEGMENT
*D*               NAME IS NOT FOUND, THE PROCESSOR IS ABORTED WITH
*D*               ERROR CODE B1-01.
*D*
         LCI      2
         LM,0     *SR2              R0/R1 = SEGMENT NAME.
         LI,2     ' '               BLANK-PAD
         LB,3     0                 THE TEXTC NAME
NXTBLK   CI,3     7                 IN R0/R1.
         BGE      NOPAD             ---> ALL PADDED.
         AI,3     1                 (PAD IT TO ALLOW
         STB,2    0,3                SUCCESSFUL COMPARISON
         B        NXTBLK             WITH P:NAME ENTRIES.)
NOPAD    CD,0     P:NAME,4          IS THIS THE SEGMENT...
         BE       SEG30             ---> YES.  (R4= P: INDEX.)
         LB,4     PB:LNK,4          NO. KEEP LOOKING.
         BNEZ     NOPAD             ---> MORE OVERLAY SEGMENTS.
         LI,14    X'B1'
         B        T:ABORTM        -----> BAD NEWS.
*E*
*E*      ERROR:   B1-00
*E*      MESSAGE: CAN'T FIND THAT OVERLAY SEGMENT
*E*
SEG30    EQU      %
         BAL,1    T:PROCOV
MSEGLDEX B        TRAPEXIT
         PAGE
*
RTCHK    EQU      % ***************************************************
*                 THIS ROUTINE IS CALLED TO CHECK IF THE CURRENT USER
*                 IS A REAL-TIME USER WHO HAS LOCKED HIMSELF IN CORE.
*                                   BAL,R1
*                                   INPUT:  NONE
*                                   OUTPUT: R4=CURRENT USER #
*                                           CC2 SET IF ABOVE IS TRUE
*                                   WORK REGS: R1,R2
*
         LW,R4    S:CUN             CURRENT USER #
         LH,R2    UH:FLG2,R4
         CI,R2    FLG:LIC           REAL-TIME USER LOCKED IN CORE?
         B        0,R1
RTCHKERR EQU      %                 RETURN HERE IF ABOVE CONDITION EXISTS
*                                   WHEN RTCHK IS CALLED FROM WITHIN ALTCP
         LW,14    RTERR             ABORT CODE
         B        CALBAD
         PAGE
T:SYSLOAD EQU     %
         LI,1     -10               POINT TO REG 5 INSTACK
         LW,8     C:ETM             EXECUTION TIME MULTIPLIER
         LW,9     C:RT90            90% RESPONSE TIME
         LW,10    S:CUIS            CURRENT USERS IN SYSTEM
         LCI      3
         STM,8    *TSTACK,1
         B        TRAPEXIT
         SPACE    3
MFSI     EQU      %
         CI,6     1                 IS IT M:FSI OR M:ASI?
         BANZ     MASI              B IF M:ASI
         LI,0     T:FSI#
         B        %+2
MASI     LI,0     T:ASI#
         LI,2     LDLNKSEG
         B        T:OVER            GO DO IT...
         PAGE
CKLIMIT  EQU      %
         LI,1     0
         LW,2     J:JIT
         BEZ      CKLIMOK
         LW,2     S:CUN
         LH,2     UH:FLG,2
         CI,2     X'1000'
         BANZ     CKLIMOK
         AI,15    3
         SLS,15   -2
         AW,15    7
         AND,15   M17
         SLS,7    -9
         SLS,15   -9
CKLM1    BAL,11   T:IACU
         STCF,0   11
         CW,11    1
         BLE      %+2
         LW,1     11
         AI,7     1
         CW,7     15
         BLE   CKLM1         CHECK ALL PAGES
CKLIMOK  LC       1
         B        *0
         PAGE
*                 M:TRAP PROC.  SET/RESET MASK/UNMASK, OR RESTORE
*                 OLD TRAP CONDITIONS. RETURN PREVIOUS SETTINGS IN
*                 SR1,SR2.
*
*                   R7 = PLIST + 1, R6 = FIRST PARAMETER.
*
*                   BYTE  0= RESET, 1= SET, 2= MASK, 3= UNMASK
*                   BIT  2=NAO, 3=UI, 4=PS, 5=FP, 6=DEC, 7=FX.
*                   BIT 0, WD 1 = 1 FOR RESTORE
*
MTRAP    LI,R1    -17
         AW,R1    TSTACK
         LD,D3    *R1
         LW,D2    0,R7
         BLZ      RSTRTRAP
         LW,R4    USRENT+J:JIT
         LI,R7    X'1FFFF'
         STS,R6   USRENT+J:JIT
         LW,R2    TRPFLAGS+J:JIT
         LH,R3    D3
         LH,D1    R2
         STH,D1   R3
         LI,R6    -7
         LCI      2
         STM,R3   *TSTACK,R6
*                 PREVIOUS TRAP CONDITIONS STORED INTO USER REGS SR1,SR2
         SLD,D1   8
         AND,D1   M7
         AI,D2    0                 CHK BAD CAL BIT
         BGE      MTRAP2            NO BRANCH
         OR,D1    X80               SET BAD CAL BIT
MTRAP2   EQU      %
         EOR,D1   M32
         SCS,D1   TRAPFLGB
         AND,R2   D1
         SLD,D1   8
         AND,D1   M7
         AI,D2    0
         BGE      MTRAP4            NO, BRANCH
         OR,D1    X80               SET BAD CAL BIT
MTRAP4   EQU      %
         SLS,D1   TRAPFLGB
         OR,R2    D1
         STW,R2   TRPFLAGS+J:JIT
*                 TRAPFLAG RESTORED WITH NEW SET AND RESET OPTIONS.
         LB,D1    D2
         SLS,D1   16
         SLD,D1   4
         AND,D1   Y003
         AND,D2   Y003
         EOR,D2   M32
         AND,D3   D2
         OR,D3    D1
MTRAPX   STD,D3   *R1
         SCS,14   -8
         LW,6     J:TCB
         BNEZ     TRAPEXIT
         LW,6     TSTACK+5
         STW,6    J:TCB
         B        TRAPEXIT
RSTRTRAP LW,D1    0,R6
         LW,R2    1,R6
         LI,R3    X'1FFFF'
         STS,R2   USRENT+J:JIT
         LW,D2    Y01FE
         STS,R12  TRPFLAGS+J:JIT
         STH,D1   D1
         LW,D2    Y003
         STS,D1   D3                         DM,DM
         B        MTRAPX
         PAGE
*
*        M:SYS CAL PROCESSOR
*
T:SYS    EQU      %
         LW,R7    TSTACK
         AI,R7    -17               PICK UP ADDR(PSD) IN TSTACK
         LI,R12   QUEUE
         LI,R13   QUEUE1
         LI,R14   NEWQ              SET UP ADDRESSES OF I/O ROUTINES
         LCI      3                  IN USRE'S REGS 8,9, AND 10
         STM,R12  10,R7               IN THE PUSHED ENVIRONMENT.
*
         LB,R0    JB:PRIV
         CI,R0    X'C0'             IF PRIVILEGE .GE. X'C0',SET HIS
         BGE      SETMASTR           TO MASTER MODE, WRITE KEY 0.
*
         LW,R0    PR:MS             SEE IF THIS IS A PRIVILEGED
         CW,R0    J:UPRIV            PROCESSOR ISSUING M:SYS
         BANZ     SETMASTR          THAT'S GOOD ENUF...GO AHEAD
         B        CC1SET            NON-PRIVILEGED CALLER RETURN
*
SETMASTR EQU      %
         LI,R0    0
         LW,R1    Y009              MASTER MODE, AM RESET
         LD,R2    *R7               PICK UP CURRENT PSD...
         STS,R0   R2                 RESET SLAVE AND AM TRAP BITS
*                                   (MAKE MASTER MODE)
         LI,R3    0                 AND SET WRITE KEY TO 0
         STD,R2   *R7                AND PUT PSD BACK IN PUSHED ENVIR.
         B        CC0RST            PRIVILEGED CALLER RETURN
         END

