*M*      STPNR    JOB STEP CONTROL
*P*
*P*      NAME:    STPNR
*P*
*P*      PURPOSE: TO PERFORM ALL OPERATIONS NECESSARY TO ALLOW A USER
*P*               TO PASS FROM ONE JOB STEP TO THE NEXT.  A JOB STEP IS
*P*               DEFINED HERE TO BE FROM THE TRANSFER OF CONTROL
*P*               TO THE START ADDRESS OF A USER PROGRAM OR PROCESSOR
*P*               TO ITS EXIT, ERROR OR ABORT.
*P*
*P*               COMMAND PROCESSORS SUCH AS TEL AND CCI PROVIDE THE
*P*               MEANS BY WHICH A USER SPECIFIES JOB STEPS,
*P*               AND THEIR OPERATION IS CONSIDERED PART OF THE
*P*               INTER-JOB STEP PROCESS.
*P*
*P*
*P*      DESCRIPTION: STEP IS AN OVERLAY ENTERED FROM THE RESIDENT
*P*               MODULE 'STEP'. UPON ENTRY CONTROL WILL PASS TO ONE
*P*               OF SEVERAL ROUTINES TO PERFROM THE DESIRED STEP
*P*               FUNCTION.
*P*
*P*               THE CODE IN STPNR IS EXECUTED MAPPED AND IN THE
*P*               MASTER MODE.
*P*
*P*      REFERENCE: REPORT F AND REPORT D
*P*
         PCC      0
         TITLE    'MODULE DEFS'
MONPROC  SET      1
UFLAGS   SET      1
BITS     SET      1                 GET DEFINITIONS OF XN,YN,MN.
         SYSTEM   UTS
*
*        MODULE DEFS
*
         DEF      STPNR:            MODULE NAME
         DEF      STPOVR            DRIVE TO REQUIRED STPNR ROUTINE
*
STPNR:   B        STPOVR
         TITLE    'MODULE REFS'
*
*        JIT REFS
*
         REF      J:JIT             WORD ADDR OF THE JIT
         REF      JIT               WORD ADDR OF THE JIT
         REF      J:ACCN            2 WORDS FOR USER'S ACCOUNT
         REF      JACCN             USER'S ACCOUNT
         REF      JUNAME            USER'S NAME
         REF      J:TREE            TREE TABLE ADDR OF EXECUTING PROGRAM
         REF      J:ABC             ABORT CODE
         REF      ERO               ERROR CODE
         REF      J:ABUF            ADDR OF ASSIGN/MERGE BUFFER IF IN
*,*                                  CORE, 0 IF NOT
         REF      J:AMR             DISC ADDR OF THE ASSIGN/MERGE RECORD
         REF      J:ASSIGN          1 BIT FLAGS
         REF      J:BASE            SPILL BUFFER FOR INDEX BUFFERS
         REF      J:CFLGS           FLAGS FOR LINK/LDTRC TO SHARED PROC
         REF      J:CLS             CLOSE STATUS INFORMATION
         REF      J:EXLY            EXECUTE ONLY BIT IN J:ASSIGN
         REF      J:EXTENT          FLAGS AND ADDR OF EXIT CONTROL ROUTINE
         REF      J:ICBHDR          ADDR OF ICB OF LATEST INTERRUPT (R/T)
         REF      J:INTENT          BREAK CONTROL ROUTINE ADDR
         REF      J:JIP             NONZERO IF M:JOB IN PROGRESS.
         REF      J:TIMENT          M:STIMER ROUTINE ADDR
         REF      J:USENT           USRE'S TRAP CONTROL ROUTINE ADDR
         REF      J:DCBLINK         ADDR OF THE DCB TABLE
         REF      J:LMN             NAME OF LAST LMN FORMED BY THE LOADER
         REF      J:MRT             MAX RUN TIME (0 = NO MAX)
         REF      J:RNST            RUN STATUS
         REF      J:UPRIV           PRIVILEGE FLAGS
         REF      J:PPRIV           PRIVILEGE FLAGS
         REF      PR:MS              M:SYS PERMISSION
         REF      PR:MM              MAX MEMORY
         REF      PR:SJ              SPECIAL JIT ACCESS
         REF      PR:PA              PROCESSOR ACCOUNTING
         REF      J:RWECB           ECB BLOCK FROM M:READ/M:WRITE
         REF      J:ALB             CAL3 VECTOR ADDRESS IN JIT
         REF      J:XPSD            USER XPSD AREA FOR CAL3'S
         REF      J:STAR            LIST OF STAR FILE FIT ADDRS
         REF      J:START           START ADDR OF THE CURRENT PROGRAM
         REF,1    JB:MNPA           MAX CORE LIMIT
         REF,1    JB:FRS            * IN ORDER TO SET IT CORRECTLY
         REF      J:TCB             TCB ADDR OF EXECUTING PROGRAM
         REF      J:TELFLGS         FLAGS USED BY TEL AND CCI
         REF      J:CCBUF           FOR !XEQ COMMAND
         REF      JB:CCARS          FOR !XEQ COMMAND
         REF      J:BUP             VP# OF BEGINNING USER'S PAGE
         REF      J:EUP             VP# OF ENDING USER'S PAGE
         REF      J:DLL             VP# OF FIRST DATA PAGE
         REF      J:DUL             VP# OF LAST DATA PAGE
         REF      J:DCBLL           VP# OF FIRST DCB PAGE
         REF      J:DCBUL           VP# OF LAST DCB PAGE
         REF      J:PLL             VP# OF FIRST PROCEDURE PAGE
         REF      J:PUL             VP# OF LAST PROCEDURE PAGE
         REF      J:DDLL            VP# OF FIRST DYNAMIC DATA PAGE
         REF      J:DDUL            VP# OF LAST DYNAMIC DATA PAGE
         REF      JB:PCP            # OF PGS OF PROC/DATA/DYN. DATA/CONTEXT
         REF      JB:PCDCB          # OF PGS OF DCBS (BYTE 0)
         REF      JB:TDP            TOP DYNAMIC PAGE (BYTE 0)
         REF      JB:BCP            BOTTOM COMMON PAGE (BYTE 1)
         REF      JBBCP             BYTE INDEX TO JB:BCP
         REF      JBTDP             BYTE INDEX TO JB:TDP
         REF      JEUPVP            DEFAULT END USER PAGE (X'DF')
         REF      JBUPVP            DEFAULT BEGINNING USER PAGE (X'50')
         REF      JBUPVPA           WORD ADDR OF DEFAULT BEGINNING USER PG
         REF      SBUF1VPA          WORD ADDR OF SPECIAL BUFFER 1
         REF      SBUF2VPA          WORD ADDR OF SPECIAL BUFFER 2
         REF      JXBUFVP           VP# OF FIRST SPARE BUFFER
         REF      JOVVP             VP# OF LAST SPARE VP + 1
         REF      JBCBLL            BYTE INDEX TO LOWEST COOP SPARE BUFFER
         REF      JB:FBUL           VP# OF HIGHEST FILE MNG SPARE BUFFER
         REF      JBNFPOOL          # OF BUFFERS REQUESTED ON !POOL COMMAND
         REF      SPDBASE           DELTA'S DATA BIAS
         REF      SPPBASE           DELTA'S PROCEDURE BIAS
         REF      JB:LMAP           USER'S VIRTUAL PAGE CHAIN
         REF      JB:VLH            VIRTUAL PAGE CHAIN HEAD
         REF      JAJITVP           VP# OF USER'S AJIT
         REF      JX:CMAP           USER'S PHYSICAL PAGE MEMORY MAP
         REF      JB:PRIV           PRIVILEGE LEVEL OF THE JOB
         REF      GZPRIV            BIT IN JB:PRIV TO ENABLE PAGE CLEANING
         REF      JB:PROMPT         CURRENT PROMPT CHARACTER
         REF      JB:DPROMPT        MOVE DEFAULT TO CURRENT PROMPT
         REF      JB:STEP           COUNT OF JOB STEPS
         REF      JB:STEPCC         STEP CONDITION CODES FOR THIS JOB  STEP
         REF      JH:LDCF           PERIPHERAL AUTHORIZATION FLAGS
         REF      JTSTACKSZ         LENGTH OF TSTACK
         REF      SS                SENSE SWITCH SETTINGS
         REF      M:UC              M:UC DCB FOR ON-LINE USER
         REF      M:XX              DCB FOR USE BY THE SYSTEM
         REF      MXFPL             ADDR OF M:XX FUNCTION PARAMETER LIST
         REF      MPPO              MAXIMUM PROCESSOR PAGES
         REF      MPO               MAXIMUM CARD PUNCH OUT
         REF      MDPO              MAXIMUM DIAGNOSTIC PAGES
         REF      MUPO              MAXIMUM USER PAGES
         REF      TMPDCPK           TEMP RAD SPACE REMAINING
         REF      TMPDPPK           TEMP DISC SPACE REMAINING
         REF      TMDCRM            TEMP RAD SPACE THAT CAN BE USED
         REF      TMDPRM            TEMP DISC SPACE THAT CAN BE USED
         REF      PRDCRM            PERM RAD SPACE REMAINING
         REF      PRDPRM            PERM DISC SPACE REMAINING
         REF      ALOCCT            # OF GRANULES EXTENDED FOR EXIT CONTROL
         REF      ONLN              USED TO DETERMIN IF USER IS ON-LINE
*
*        ASSIGN/MERGE RECORD REFS
*
         REF      AM:ORG            POINTER TO AVAIL. SPACE
         REF      AM:LNK            POINTER TO FIRST PLIST
         REF      AM:CKSM           A/M CHECKSUM
         REF      AM:PRCUR          USERS DEFAULT PRIVILEGE BITS
*
*        USER TABLE REFS
*
         REF      UH:FLG            USER FLAGS
         REF      UH:FLG2           USER FLAGS
         REF      U:MISC            FOR WAIT EVENT
         REF      UH:WL
         REF      UB:NECB
         REF      UH:JIT            JIT DISC ADDRESS
         REF      UH:AJIT           AJIT DISC ADDRESS
         REF      UB:ACP            USER'S COMMAND PROCESSOR #
         REF      UB:APR            ASSOCIATED STANDARD SHARED PROCESSSOR #
         REF      UB:APO            OVERLAY # OF ASSOCIATED SHARED PROCESSOR
         REF      UB:ASP            ASSOCIATED SPECIAL SHARED PROCESSOR #
         REF      UB:DB             ASSOCIATED DEBUGGER #
*
*        SHARED PROCESSOR TABLE REFS
*
         REF      P:NAME            ROOT OR OVERLAY NAME IN TEXTC FORMAT
         REF      MAXOVLY           INDEX# + 1 OF LAST MONITOR OVERLAY
         REF      PNAMEND           INDEX# + 1 OF LAST ROOT ENTRY
         REF      PPROCS            INDEX# + 1 OF LAST OVERLAY ENTRY
         REF      P:SA              FLAGS AND START ADDRESS
         REF      P:TCB             TCB ADDRESS (0=NONE)
         REF      PB:DSZ            # OF PAGES OF DATA
         REF      PB:DCBSZ          # OF PAGES OF DCBS
         REF      PB:PSZ            # OF PAGES OF PURE PROCEDURE
         REF      PB:PVA            VP# OF FIRST PROCEDURE PAGE
         REF      PB:HVA            VP# OF LAST PROCEDURE PAGE +1
         REF      PB:LNK            PROCESSOR TABLE INDEX OF NEXT OVERLAAY
         REF      PB:UC             # OF IN-CORE USERS ASSOCIATED
         REF      PB:REP            TOTAL # OF USERS ASSOCIATED
*
*        GHOST JOB TABLE REFS
*
         REF      SB:GJOBUN         GHOST JOB USER NUMBER
         REF      S:GJOBTBL         TEXTC NAME OF GHOST JOBS
         REF      MING              MAX # OF SYSTEM GHOST JOBS
         REF      MAXG              MAX # OF GHOST JOBS IN THE SYSTEM
*
*        MONITOR DATA
*
         REF      S:CUN             CURRENT USER NUMBER
         REF      OPNCLSUS          OPEN/CLOSE USER-TO SEE IF T:UBLKOCU
*,*                                  SHOULD BE CALLED AT USER RUNDOWN
         REF      CAL3PSD           DEFAULT CAL3 HANDLER XPSD IN ROOT
         REF      S:CRASHUN         SINGLE USER ABORT USER #
         REF      DID               ID OF DIAGNOSTIC USER-RESET AT RUNDOWN
         REF      S:PCORE           DECREMENTED WHEN R/T USER LOCKED
*,*                                  IN CORE ABORTS OR EXITS
         REF      S:ACORE           DECREMENTED WHEN R/T USER LOCKED
*,*                                  IN CORE ABORTS OR EXITS
         REF      DOUBLEZERO        USED FOR NULL FPT
         REF      HEX               USED TO CONVERT ERROR CODE TO BCD
         REF      0PSD              USED TO EMPTY TSTACK
         REF      SYSACT            TEXT ':SYS'
         REF      TXTCFU            TO CHECK FOR M:* DCB
*
*        SYSGEN LIMITS FOR EXTENDED PROCESSING
*
         REF      SL:ETIME          INCREMENT FOR MAX RUN TIME
         REF      SL:ELO            INCREMENT FOR MAX PROCESSOR PAGES
         REF      SL:EPO            INCREMENT FOR MAX CARD PUNCH
         REF      SL:EDO            INCREMENT FOR MAX DIAGNOSTIC PAGES
         REF      SL:EUO            INCREMENT FOR MAX USER PAGES
         REF      SL:ETS            INCREMENT FOR TEMP RAD AND PACK
         REF      SL:EPS            INCREMENT FOR PERM RAD AND PACK
*
*        MASKS
*
         REF      NB31TO0           31 BIT MASKS
         REF      MN9               X1FE00  USED BY DCB CHECKER
         REF      XFC
         REF      XFFFD
         REF      XFFFF00
         REF      X1FE00
         REF      YFF
         REF      YFFF
         REF      Y00FF
         REF      Y003E
         REF      Y07
         REF      S:OPTION          FOR !XEQ SUPPRESSION BIT
         REF      YC
         REF      X1FFFF             17-BIT ADDRESS MASK
*
*        MM REFS
*
         REF      T:FPP             TO RETURN AJIT PG WHEN DELETING A USER
         REF      T:GBUF            TO GET A SPECIAL BUFFER FOR STEP'S
*,*                                  DATA PAGE, FOR THE ASSIGN/MERGE
*,*                                  LOGIC AND FOR THE DCB CHECKER
         REF      T:RBUF            TO RETURN A SPECIAL BUFFER
         REF      T:ZBUF            TO RELEASE ALL FM BUFERS
         REF      T:GNVNPI          TO GET SHARED PROCESSOR DATA AND
*,*                                  DCB PAGES (GET VIRTUAL, NO PHYSICAL)
         REF      T:GNVPI           TO GET PAGES FOR AN UNSHARED PROGRAM
         REF      T:RVPI            TO RELEASE PAGES WHEN RUNNING DOWN A
*,*                                  A USER
         REF      FPMC              TO CHECK FOR FREE PAGE IN USER AREA
         REF      PAGEZAPT          TO CLEAN BLANK COMMON AND PAGED
*,*                                  LOAD MODULES PAGES
         REF      PAGEZAP0          TO CLEAN FIRST AND LAST PAGE FOR
*,*                                  STANDARD LOAD MODULE
         REF      T:RVSPI           TO ORDER COMMON PAGES IN CLIST
*,*                                  AFTER LDTRC (RELEASE VP, SAVE PP)
         REF      T:GVGPI           TO ORDER COMMON PAGES IN CLIST
*,*                                  AFTER LDTRC (GET VP GIVEN PP)
         REF      T:PAC             TO LOAD THE ACCESS CODES FOR THE
*,*                                  SPECIAL SHARED PROCESSOR AREA
         REF      T:SAC             TO RESET THE ACCESS CODES AFTER
*,*                                  RELEASING USER PAGES
         REF      T:SNAC            TO SET THE ACCESS CODES WHEN OBTAINING
*,*                                  PAGES FOR THE USER PROGRAM
         REF      T:TOTESZ          TO FIND USER SIZE WHEN ASSOCIATING
*,*                                  A SHARED PROCESSOR
         REF      T:SGR             TO RELEASE JIT AND AJIT SWAP
*,*                                 GRANULES WHEN DELETING A USER
*
*        T:OV REFS
*
         REF      CLSALL#           TO CLOSE ALL USER DCBS
         REF      CLSSEG            FOR CLSALL#
         REF      DEBUGSEG          TO GIVE USER ERR MSG AND PMD'S
         REF      LEXIT#            CLEAN UP LNKTRC AT USER RUNDOWN
         REF      T:SAVESWAPIMG#    FOR AUTO SAVE ON LINE HANG-UP
         REF      LDLNKSEG          FOR LEXIT# AND T:SAVESWAPIMG#
         REF      T:GHOST#          TELL OPERATOR ABOUT GHOST JOB ABORT
         REF      T:DSMT#           DISMOUNT TAPES WHEN DELETING A USER
         REF      MISOVSEG          FOR T:GHOST# AND T:DSMNT#
         REF      OPNSEG            TO OPEN M:XX
         REF      TQOV1SEG          FOR TP QUEUE PURGE AT RUNDOWN
         REF      RTRNDWN#          RUNDOWN R/T ACTIVITY AT EXIT
         REF      RTNRRTSEG         FOR RTRNDWN#
         REF      T:JECLS#          FOR PURGING PARTIAL M:JOB FILE.
         REF      LDTSETUP#         FOR FAKE M:LDTRC ON EXIT.
*
*        SCHED REFS
*
         REF      DASP              DECREMENT PB:UC FOR ASP/DB
         REF      DPROCS            DECREMENT PB:UC FOR ALL ASSOCIATED
*,*                                  SHARED PROCESSORS
         REF      DRTEL1            RESET TIC AND DECREMENT PB:UC FOR ACP
         REF      DTEL              DECREMENT PB:UC FOR ACP
         REF      IPROCS            INCREMENT PB:UC FOR ALL ASSOCIATED
*,*                                  SHARED PROCESSORS
         REF      ISTEL1            SET TIC AND INCREMENT PB:UC FOR ACP
         REF      T:REG             REPORT EVENT AND GIVE UP
         REF      T:SSEM            TRANSFER CONTROL TO USER
         REF      DELTAGO           TRANSFER CONTROL TO DELTA
         REF      T:UTSXTS          COPY ENVIRONMENT FROM TSTACK TO USER
*,*                                  STACK-USED BY EXIT CONTROL LOGIC
         REF      E:AP              ASSOCIATE SHARED PROCESSOR EVENT
         REF      E:QMF             MF TO BIG EVENT (ECB WAIT)
         REF      E:SL              SLEEP EVENT-WAIT WHEN :PROCS FILE
*,*                                  IS BUSY
         REF      SCU               STATE CURRENT USER
*
*        MISC ROUTINES
*
         REF      MSRRDWT           USED BY FETCH TO READ UNSHARED PROGRAM
         REF      RSTRTN            USED TO RESET IMPLICIT RETURN BITS
*,*                                  IN J:RNST
         REF      XIT31RT           TO RELOAD THE USER'S MAP AND ACCESS
         REF      T:UBLKOCU         TO UNBLOCK OPEN/CLOSE USER AT RUNDOWN
         REF      STEP70            TO COMPLETE THE DELETE USER LOGIC
         REF      PUSHALL           TO SIMULATE AN OVERLAY CALL
*,*                                   TO T:AMRDWT
         REF      CHKDA             CHECK DISC ADDR. OF ASSIGN/MERGE RECORD
         REF      GBG               GET GRANULE TO WRITE THE ASSIGN/MERGE RECORD
         REF      IOSPIN            WAIT FOR COMPLETION OR READ/WRITE
         REF      MSR01EXIT         ERROR EXIT AFTER READ/WRITE OF A/M RECORD
         REF      MSRWRTX           NORMAL EXIT AFTER READ/WRITE A/M RECORD
         REF      PUTSZBF1          USER BUF,RWS TO MON QBUF,BLK.
         REF      QUEUE             TO READ/WRITE THE ASSIGN/MERGE RECORD
         REF      T:IACU            TO CHECK ACCESS CODES ON THE A/M BUFFER
         REF      RTCHK             SEE IF USER IS LOCKED IN CORE.
         REF      COCGLN            GET COC LINE NUMBER
         SREF     COCSTERM          RESET TERM TYPE ON LOGOFF
*
*        COC TABLE SREFS
*
         SREF     COCOC             RESET HANG-UP BIT
         SREF     DUMPLINE          RESET DUMP-ENABLED USER AT LOGOFF
         SREF     LB:UN             USER # ASSOCIATED WITH COC LINE
         SREF     LNOL              MAX # OF COC LINES
         SREF     MODE2             TO RESET ACTIVATION CHARACTER
         SREF     MODE3             TO RESET HALF-DUPLEX PAPER TAPE MODE
         SREF     MODE5             TP SLAVE LINE SWITCHES
         SREF     MODE6             TO CHECK FOR HARDWIRED LINES
         SREF     EOMTIME           TIME LEFT FOR TP ACQUIRE
*
*        READ AHEAD SREFS
*
         SREF     RA:ABNNN          # OF UNUSED READ AHEAD BUFFERS
         SREF     RA:DA             DISC ADDRESS AND FLAGS
         SREF     RAB:FLINK         LINK TO NEXT NEWEST ENTRY
         SREF     RAB:USER          USER ASSOCIATED WITH ENTRY
         SREF     T:RAREL           TO RELEASE A READ AHEAD ENTRY
*
*        MISC SREFS
*
         SREF     ECBPOST1          TO POST M:READ/M:WRITE ECB AT RUNDOWN
         SREF     ENQ               TO DEQUEUE ANY OUTSTANDING ENQUEUE
*,*                                  CALS AT RUNDOWN
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         TITLE    'DATA'
*
*        FIRST HALF WORD OF USER FLAGS
*
*
* UH:FLG |---------------------------------|
*        |        |       |    1 1|1 1 1 1 |
*        | 0 1 2 3|4 5 6 7|8 9 0 1|2 3 4 5 |
*        |-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-|
*          | | | | | | | | | | | | | | | |
*          | | | | | | | | | | | | | | | > READY -READY TO RUN
*          | | | | | | | | | | | | | | > UNUSED-1
*          | | | | | | | | | | | | | > :ACCTLG OR :USERS OPEN
*          | | | | | | | | | | | | > OPNCLS USER
*        --------------------------------------------------------------------
*          | | | | | | | | | | | > PPSWAP-PURE PROCEDURE MUST BE SWAPPED
*          | | | | | | | | | | > INTERACTIVE USER
*          | | | | | | | | | > DELIC -DELTA IS IN CONTROL
*          | | | | | | | | > TELIC -TEL IS IN CONTROL
*        ---------------------------------------------------------------------
*          | | | | | | | > BATJOB-JOB IS A BATCH JOB
*          | | | | | | > JITIC -JIT IS IN CORE
*          | | | | | > DELASS-DELTA IS ASSOCIATED
*          | | | | > INIT -INITIALIZATION MUST BE DONE
*        ---------------------------------------------------------------------
*          | | | > SPEC. JIT ACCESS
*          | | > DCBS - INITIAL DCBS ARE BEING SWAPPED IN
*          | > STEP IN PROGRESS OR UNBLOCK RECEIVED BEFORE BLOCK EVENT
*          > BYPASS - AVAILABLE CORE IS TEMPORARILY TOO SMALL FOR USER
*
         PAGE
*
*        SECOND HALF-WORD OF USER FLAGS
*
*        FLAGS IN THIS GROUP ARE MOSTLY SWAPPER RELATED
*
*
* UH:FLG2|---------------------------------|
*        |        |       |    1 1|1 1 1 1 |
*        | 0 1 2 3|4 5 6 7|8 9 0 1|2 3 4 5 |
*        |-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-|
*          | | | | | | | | | | | | | | | |
*          | | | | | | | | | | | | | | | > JIT SWAP ERROR
*          | | | | | | | | | | | | | | > CONTEXT SWAP ERROR
*          | | | | | | | | | | | | | > USER SWAP ERROR
*          | | | | | | | | | | | | > SWAP QUANTUM NOT SATISFIED
*        ---------------------------------------------------------------------
*          | | | | | | | | | | | > JUST SWAPPED IN
*          | | | | | | | | | | > COC LINE HANG-UP
*          | | | | | | | | | > 9
*          | | | | | | | | > 8
*        --------------------------------------------------------------------
*          | | | | | | | > TP FUNCTION
*          | | | | | | > INTERRUPTED DURING A CAL
*          | | | | | > SYSTEM GHOST LOCKED OUT (REAL TIME LOCK IN CORE)
*          | | | | > REAL TIME LOCK IN CORE (ABSOLUTE)
*        --------------------------------------------------------------------
*          | | | > COC EVENT FOR TRANSACTION PROCESSING
*          | | > LOCK IN CORE FOR RMA (GENTLE)
*          | > COMMAND PROCESSOR BREAK
*          > 0
         PAGE
*
*        USED FOR EXIT CONTROL FLAGS
*
*        EXIT CONTROL ADDRESS IN BITS 15-31
*
*
*J:EXTENT|---------------------------------|
*        |        |       |    1 1|1 1 1 1 |
*        | 0 1 2 3|4 5 6 7|8 9 0 1|2 3 4 5 |
*        |-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-|
*          | | | | | | | | |
*          | | | | | | | | > LAST OPTION SPEC. FOR EXIT CONTROL
*        --------------------------------------------------------------------
*          | | | | | | | > STEP CC
*          | | | | | | > EXIT CONTROL EST. C-Y & QUIT SEQUENCE
*          | | | | | > UNUSED
*          | | | | > M:LINK OR M:LDTRC EXIT CONTROL
*        ---------------------------------------------------------------------
*          | | | > EXIT CONTROL ESTAB. BY COMMAND PROCESSOR
*          | | > EXIT CONTROL IN PROGRESS
*          | > SOME LIMIT EXCEEDED
*          > OPERATOR ABORT OR LINE HANGUP
*
         PAGE
*
*
*        RUN STATUS
*
*        IF 0 THEN THE JOB IS EXECUTING NORMALLY
*
*
*J:RNST  |---------------------------------|
*        |        |       |    1 1|1 1 1 1 |
*        | 0 1 2 3|4 5 6 7|8 9 0 1|2 3 4 5 |
*        |-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-|
*          | | | | | | | | | | | | |
*          | | | | | | | | | | | | > LOADER RUNNING
*        -------------------------------------------------------------------
*          | | | | | | | | | | | > USER RUNNING
*          | | | | | | | | | | > PROCESSOR RUNNING
*          | | | | | | | | | >CMND FOR PROCESSOR IN CCBUF
*          | | | | | | | | > CCBUF FULL
*        -------------------------------------------------------------------
*          | | | | | | | > ILLEGAL TRAP
*          | | | | | | > I/O ERROR
*          | | | | | > LIMIT EXCEEDED
*          | | | | > TERMINAL HANG UP
*        ---------------------------------------------------------------------
*          | | | > X KEYIN
*          | | > E KEYIN
*          | > M:XXX
*          > M:ERR
*
         PAGE
*
*
*        PROCESSOR FLAGS AND START ADDRESS
*
*        ADDRESS IS IN BITS 15-31
*
*
*P:SA    |---------------------------------|
*        |        |       |    1 1|1 1 1 1 |
*        | 0 1 2 3|4 5 6 7|8 9 0 1|2 3 4 5 |
*        |-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-|
*          | | | | | | | | |
*          | | | | | | | | > C - CORELIB SPECIFIED
*        -----------------------------------------------------------------
*          | | | | | | | > G - LEGAL FOR GHOST USERS
*          | | | | | | > B - LEGAL FOR BATCH USERS
*          | | | | | > T - LEGAL FOR TERMINAL USERS
*          | | | | > M - MAXIMUM MEMORY
*        ----------------------------------------------------------------------
*          | | | > P - CORE LIBRARY (BIT 1 ALSO SET)
*          | | > D - DEBUGGER (BIT 1 ALSO SET)
*          | > S - SPECIAL SHARED PROCESSOR
*          > J - SPECIAL JIT ACCESS
*
         PAGE
*D*
*D*      NAME:    THE INTERPRETIVE EXIT ENVIRONMENT
*D*
*D*                               DECIMAL DISPLACEMENT FROM TOP OF TSTACK
*D*           THREE WORDS         -18
*D*               FOR             -17
*D*           USER PSD            -16
*D* REGISTERS
*D*      0    THREE WORDS         -15   MEANINGFUL ONLY IF
*D*      1        FOR             -14     TEL PERFORMED THE
*D*      2    DEBUGGER NAME       -13       EXIT
*D*
*D*      3    UNUSED              -12
*D*
*D*      4    TWO WORDS           -11   SET BY INTERPRETIVE EXIT
*D*      5    FOR C.P. NAME       -10     LOGIC AT STEP004
*D*
*D*      6    THREE WORDS FOR     - 9   ADDRESS OF RUN TABLE
*D*      7    REQUESTED           - 8     IF CCI PERFORMED THE EXIT.
*D*      8    PROGRAM NAME        - 7   =0 MEANS LOGOFF OR CONTINUE
*D*
*D*      9    UNUSED              - 6
*D*
*D*      A    TWO WORDS FOR       - 5
*D*      B      PASSWORD          - 4
*D*
*D*
*D*      C    UNUSED              - 3
*D*
*D*      D    TWO WORDS FOR       - 2
*D*      E      ACCOUNT           - 1
*D*
*D*      F    RUN TABLE ADDR.     <-----------TOP OF TSTACK
*D*
         PAGE
*D*
*D*      NAME:    STEP'S DATA PAGE
*D*
*D*      DESCRIPTION: STEP REQUIRES THE USE OF A PAGE THAT MAY BE
*D*               USED TO STORE DATA CONCERNING AN UNSHARED PROGRAM
*D*               THAT IS TO BE PUT INTO EXECUTION.  STEP USES
*D*               SPECIAL BUFFER 1 (SBUF1VP) FOR THIS DATA PAGE.
*D*
*D*               IF THE LOAD MODULE IS CALLED BY THE CCI !RUN CONTROL
*D*               COMMAND OR BY M:LINK OR M:LDTRC, THE LOAD MODULE
*D*               IS READ INTO CORE BY THE FETCH ROUTINE.  IF FETCH
*D*               DETERMINES THAT THE USE OF RUNNER IS NOT REQUIRED,
*D*               SPECIAL BUFFER 1 IS OBTAINED BY CALLING THE T:GBUF
*D*               ROUTINE IN MM.  SPECIAL BUFFER 1 IS THEN USED TO READ
*D*               THE HEAD AND TREE RECORDS OF THE REQUESTED LOAD
*D*               MODULE.
*D*
*D*               IF RUNNER IS ASSOCIATED, RUNNER WILL READ THE LOAD
*D*               MODULE HEAD RECORD INTO THE FIRST 12 WORDS OF THE
*D*               SPECIAL PROCESSOR DATA PAGE.  RUNNER PUTS INFOR-
*D*               MATION CONCERNING THE CLOBBER TABLE IN THE END OF
*D*               THE SPECIAL PROCESSOR DATA PAGE; THIS INFORMATION
*D*               WILL LATER BE PROCESSED BY FETCH.  WHEN RUNNER
*D*               EXITS, THE SPCON SUBROUTINE IS CALLED TO GET SPECIAL
*D*               BUFFER1, MOVE THE DATA FROM THE SPECIAL PROCESSOR
*D*               DATA PAGE INTO SPECIAL BUFFER1, AND RELEASE THE
*D*               SPECIAL PROCESSOR DATA PAGE.  CONTROL THEN RETURNS TO
*D*               FETCH WHERE THE HEAD RECORD IS READ INTO SPECIAL
*D*               BUFFER 1.
*D*
*D*               IF LINK HAD LOADED A PROGRAM FOR EXECUTION, CONTROL
*D*               IS GIVEN TO THE XITLINK ROUTINE.  ACTION TO BE
*D*               TAKEN BY STEP IS PASSED IN THE SPECIAL PROCESSOR
*D*               DATA PAGE.  THIS CONSISTS OF THE HEAD AND TREE RECORD
*D*               AS BUILT BY LINK, THE LOAD AND GO FLAG, AND THE
*D*               NAME OF THE DEBUGGER TO BE ASSOCIATED, IF ANY.  THE
*D*               SPCON ROUTINE SUBROUTINE IS CALLED TO GET SPECIAL
*D*               BUFFER 1, MOVE LINK'S DATA TO THAT PAGE, AND
*D*               RELEASE THE SPECIAL PROCESSOR DATA PAGE.
*D*
*D*               THUS, IN ALL CASES, THE FORMAT OF THE DATA IN STEP'S
*D*               DATA PAGE IS THE SAME.
*D*
*D*               THE FORMAT OF STEP'S DATA PAGE IS AS FOLLOWS:
*D*
*D*
*D*
*D* DISPLACE- LABEL     CONTENTS              REMARKS
*D*   MENT
*D* --------- -----     ----------------      ----------------------
*D*
*D*                     HEAD RECORD
*D*
*D*    0      HBUF      8X/00/FF/30           X=0 IF BUILT BY LOADER
*D*                                            =4 IF BUILT BY LINK
*D*                                            =5 IF PAGED LOAD MODULE
*D*                                                (LOADER BUILT)
*D*    1                00/START ADDRESS
*D*    2                TCB*/BIAS*              * INDICATES DOUBLEWORD SIZE/ADDR
*D*    3                DATA SZ*/DATA BIAS*
*D*    4                PROC. SZ*/PROC BIAS*
*D*    5                MAX REF DEF/TREE SZ
*D*    6                DCB SZ*/DCB BIAS*
*D*    7                0
*D*    8                0
*D*    9                TEXTC CORE            BIT0-WORD 9 = 1 INDICATES
*D*    A                 LIBRARY               CORELIB OPTION OF LOAD
*D*    B                  NAME                REQUIRES NON-EXTENDED
*D*                                           MEMORY MODE.
*D*    C                 TEXTC                MOVED HERE FROM TEL'S
*D*    D                DEBUGGER               EXIT ENVIRONMENT OR
*D*    E                  NAME                 LINK'S DATA PAGE
*D*
*D*                     TREE RECORD
*D*
*D*    F      TBUF      TREE SIZE             =0 IF LOAD AND GO
*D*   10      LMNKEY       TEXTC              USED TO CONTAIN KEY
*D*   11                LOAD MODULE            TO READ DATA, DCBS
*D*   12                   NAME                AND PROCEDURE
*D*   13                0
*D*   14                0
*D*   15                00 SIZE*/00 LOC*        * INDICATES DOUBLEWORD SIZE/ADDR
*D*   16                0
*D*   17                01 SIZE*/01 LOC*
*D*   18                0
*D*   19                10 SIZE*/10 LOC*
*D*   1A                0
*D*
*D*                     STEP TEMPORARY FLAGS
*D*
*D*   1B      LDRKEY    8X/XXXXXX             TO SAVE 1ST WORD OF HEAD
*D*   1C      RUNRKEY   0 OR 1                =1 IF RUNNER WAS ASSOCIATED
*D*
*D*                     RUNNER BUILT INFO.
*D*
*D*
*D*
*D*                     WORD 10 OF TREE-ROOT    POINTS TO ADDRESS IN
*D*                     WORD 10 OF TREE-SEG1     IN CLOBBER TABLE FOR
*D*                     WORD 10 OF TREE-SEG2     EACH SEGMENT
*D*
*D*
*D*
*D*  1FF                WORD 10 OF TREE-SEGN
*D*
         PAGE
USER     EQU      Y001
PROC     EQU      Y002
EXLYMSK  EQU      Y04
READFPT  EQU      %
         DATA     X'38000010'
HEAD     TEXTC    'HEAD'
TREE     TEXTC    'TREE'
TXTMGO   DATA     X'04D47AC7'
         BOUND 8
19PSD    DATA     TSTACK+20
         GEN,16,16 JTSTACKSZ-19,19
38PSD    DATA     TSTACK+39
         GEN,16,16 JTSTACKSZ-38,38
SMPSD    DATA     X'00C00000'
         DATA     0
SMFPSD   DATA     X'00F00000'
         DATA     0
         BOUND    8
RPFILE   TEXTC    ':PROCS'          RESTRICTED PROCESSOR LIST FILE
LINK     TEXTC    'LINK'
DELTA    TEXTC    'DELTA'
LOGON    TEXTC    'LOGON'
TEL      TEXTC    'TEL'
         TEXT     '    '
NRUNNER  TEXTC    'RUNNER'
TXTSGLD  TEXTC    'M:SGLD'
NQSFPT   DATA     4,X'01010002',X'7F000000',X'7F000000'
NQJFPT   DATA     4,X'05010002',X'7F000000',X'7F000000'
Y006     DATA     X'600000'
Y00200002 DATA    X'00200002'
Y00F     DATA     X'00F00000'
X17      DATA     X'17'
HEADMASK DATA     X'78FF0000'
BATCHXC  TEXTC    '!XEQ (FILE,'     BATCH !XEQ COMMAND STARTER
ONLNXC   TEXTC    'XEQ '            ONLINE !XEQ COMMAND STARTER
BATCHFAKE DATA    BATCHXC
         DATA     ','               SEPARATOR FOR !XEQ COMMAND ITEMS
         DATA     ').'              TERMINATOR FOR !XEQ COMMAND
         DATA     J:RNST            ... J:RNST
         DATA     X'00800000'       COMMAND BUFFER FULL
ONLNFAKE DATA     ONLNXC            COMMAND STARTER ADDRESS
         DATA     '.'               SEPARATOR FOR ITEMS
         DATA     X'400D'           SPACE, N/L END THE COMMAND
         DATA     J:TELFLGS         ..BITS IN J:TELFLGS
         DATA     X'00002001'       CMD BUFFER FULL, AT JOB STEP
*
*        LOAD MODULE ERROR CODES FOR ACB=A6
*
TELABORT DATA     X'040000A5'
ACPABORT DATA     X'060000A5'
BADHEAD  EQU      X'31'
BADBIAS  EQU      X'32'
BADPP    EQU      X'33'
BADDCBLOC EQU     X'34'
SMALLHEAD EQU     X'35'
SMALLTREE EQU     X'36'
NORUNNER EQU      X'37'
OUTOFUSER EQU     X'38'
NOTKEYED EQU      X'39'
BADTCB   EQU      X'3B'
PROVCOMM EQU      X'07'
NOROOMSS EQU      X'02'
NOROOM2  EQU      X'08'
EXTNDERR EQU      X'04'
LDLKSS   EQU      X'6C'
LDLKLINK  EQU     X'6B'
XBFFF    EQU      NB31TO0+15
XFFF7    EQU      NB31TO0+4
         TITLE    'DRIVER'
*F*      NAME:    STPOVR
*F*
*F*      PURPOSE: TO TRANSFER CONTROL TO THE CALLED ROUTINE WITHIN
*F*               THE STEP OVERLAY.
*F*
*F*      DESCRIPTION:  R0 HAS BEEN LOADED BY THE RESIDENT PORTION OF
*F*               STEP WITH THE INDEX TO THE ROUTINE TO BE EXECUTED.
*F*               THIS INDEX IS ADDED TO THE ADDRESS OF AN INTERNAL
*F*               BRANCH TABLE TO OBTAIN THE ADDRESS OF THE ROUTINE
*F*               WITHIN THE OVERLAY.
*F*
STPOVR   EQU      %
         BLOCK                      DONT RUN ON SLAVE CPU'S
         AI,0     DRIVE
         B        *0
DRIVE    EQU      %
         B        T:EXIT
         B        T:ERROR
         B        T:ABORT
         B        XCONSETUP
         B        KICKOFF
         B        T:SCRATCH%USER
         B        T:ASP
         B        T:ECCP
         B        T:TELDELCCI       T:ABORTM,SETRNST DONE IN RT
         B        STEPENT
         B        T:DCBCHK
         B        T:AMRDWT
         TITLE    'EXIT/ABORT USER'
*F*
*F*      NAME:    T:EXIT
*F*
*F*      PURPOSE: TO PROCESS THE M:EXIT CAL
*F*
*F*      DESCRIPTION: A CHECK IS FIRST MADE TO DETERMIND IF RUNNER
*F*               PERFORMED THE EXIT, AND IF SO CONTROL IS PASSED
*F*               TO XITRUNR TO CONTINUE THE FETCH LOGIC.
*F*
*F*               IF A COMMAND PROCESSOR IS EXITING CONTROL PASSES
*F*               TO STEP00 TO PROCESS THE INTERPRETIVE EXIT
*F*
*F*               OTHERWISE A USER OR PROCESSOR IS EXITING . R14 AND R0 ARE
*F*               SET TO ZERO TO INDICATE A NORMAL EXIT AND CONTROL
*F*               PASSES TO THE COMMON EXIT LOGIC AT SETRNST.
*F*
T:EXIT   EQU      %
         LW,4     S:CUN
         LH,15    UH:FLG,4
         CI,15    TIC               COMMAND PROC IN CONTROL MEANS
         BANZ     STEP00            STEP FUNCTION. B IF YES
         LB,13    UB:ASP,4          SPECIAL SHARED PROCESSOR #
         LD,10    NRUNNER           TEXTC 'RUNNER'
         BAL,1    CHKDRSP           IS RUNNER EXITING
         B        XITRUNR           YES-GO BACK TO FETCH
         LI,14    0
         LI,1     0                 CLEAR RUN STATUS
         B        SETRNST
         PAGE
*F*
*F*      NAME:    T:ERROR
*F*
*F*      PURPOSE: TO PROCESS THE M:ERR CAL
*F*
*F*      DESCRIPTION: R14 IS SET TO A8 TO INDICATE ERO/ABC. R1 IS SET
*F*               TO X'80' FOR M:ERR J:RNST BIT. CONTROL PASSES TO
*F*               THE COMMON EXIT LOGIC AT SETRNST.
*F*
*E*      ERROR:   A8-00
*E*      MESSAGE: YOU ISSUED AN ERROR OR ABORT CAL
*E*
T:ERROR  EQU      %
         LI,1     X'80'             SET RUNSTATUS TO ERROR CAL
         LI,14    X'A8'
         B        SETRNST
*F*
*F*      NAME:    T:ABORT
*F*
*F*      PURPOSE: TO PROCESS THE M:XXX CAL
*F*
*F*      DESCRIPTION: IF A COMMAND PROCESSOR ISSUED THE M:XXX CAL
*F*               IT IS TO ABORT THE USER AND GIVE HIM AN ERROR
*F*               MESSAGE FOR A COMMAND PROCESSOR DETECTED ERROR.
*F*               CONTROL PASSES TO RUND TO RUNDOWN THE CP.
*F*
*F*               OTHERWISE R14 IS SET TO X'A8' TO INDICATE ERO/ABC.
*F*               R1 IS SET TO X'40' FOR M:XXX J:RNST BIT AND CONTROL
*F*               PASSES TO THE COMMON EXIT LOGIC AT SETRNST.
*F*
*E*      ERROR:   A8-00
*E*      MESSAGE: YOU ISSUED AN ERROR OR ABORT CAL
*E*
T:ABORT  EQU      %
         LI,14    X'A8'
         LW,4     S:CUN
         LI,1     X'40'
         LH,15    UH:FLG,4
         CI,15    TIC
         BAZ      SETRNST
         BAL,1    RSTRTN            RESET IMPLICIT RETURN ON LDLNK
         B        RUND
         PAGE
*F*
*F*      NAME:    T:ABORTM
*F*
*F*      PURPOSE: TO FACILITATE THE MONITOR ABORTING A USER
*F*
*F*      DESCRIPTION: WHEN A MONITOR ROUTINE HAS DETERMINED THAT THE
*F*               USER IS TO BE ABORTED, R14 IS SET TO CONTAIN THE
*F*               ERO/ABC CODES AND CONTROL IS PASSED TO T:ABORTM.
*F*
*F*               R1 IS SET TO X'01' FOR THE J:RNST BIT AND CONTROL
*F*               PASSES TO THE COMMON EXIT LOGIC AT SETRNST.
*F*
T:ABORTM EQU      %
         BAL,1    RSTRTN
         LI,1     1
         PAGE
*F*
*F*      NAME:    SETRNST
*F*
*F*      PURPOSE: COMMON EXIT LOGIC
*F*
*F*      DESCRIPTION: SETRNST SETS J:RNST, JB:STEPCC(STEP CONDITION CODE),
*F*               J:ABC, AND J:ERO.  THE USERS EXIT CONTROL ROUTINE
*F*               IS THEN ENTERED IF APPLICABLE. OTHERWISE CONTROL
*F*               PASSES TO THE APPROPRIATE ROUTINE TO RUNDOWN THE
*F*               USER.
*F*
*D*      NAME:    SETRNST
*D*
*D*      REGISTERS: ALL REGISTERS ARE VULNERABLE
*D*
*D*      CALL:    ENTERED FROM T:EXIT, T:ERROR, T:ABORT, T:ABORTM
*D*
*D*      INPUT:   R14 = ERR CODE/00/00/ABORT CODE
*D*               R1 = RUN STATUS  (00 = NORMAL EXIT)
*D*                                (80 = M:ERR CAL)
*D*                                (40 = M:XXX CAL)
*D*                                (01 = MONITOR ABORT)
*D*
SETRNST  STB,1    J:RNST
T:TELDELCCI EQU   %
         LW,0     S:CUN
         SW,0     OPNCLSUS
         BNEZ     %+2
         BAL,11   T:UBLKOCU
         LI,0     0
         STW,0    J:CLS
*  AUTOMATIC SAVE ON LINE HANGUP:  RETAIN      *
*  USER'S SWAP IMAGE FOR TIME SPECIFIED IN     *
*  SL:RET.                                     *
         LB,1     J:RNST
         CI,1     8                 LINE HANGUP?
         BAZ      T:TELDEL2         NOPE
         OVERLAY  LDLNKSEG,T:SAVESWAPIMG#
T:TELDEL2 EQU     %
*D*
*D*               IF THE USER HAS EXPLICITLY SET THE STEP CONDITION
*D*               CODE VIA THE M:EXIT, M:ERR OR M:XXX CAL BIT 7
*D*               IN J:EXTENT IS SET.  THIS BIT IS RESET, FOR IN THE
*D*               EVENT WE ARE RE-ENTERED, AND THE STEP CC IS
*D*               LEFT UNCHANGED.
*D*
         LB,3     J:EXTENT
         CI,3     1                 STEPCC-SET BIT IN BIT 7
         BAZ      SETSTCC
         LI,1     X'FE'
         AND,3    1
         STB,3    J:EXTENT          RESET THE STEPCC BIT
         B        CCIN2
*D*
*D*               OTHERWISE, THE STEP CC IS SET, IF THE NEW STEP
*D*               CC IS > THE CURRENT STEP CC SETTING, AS FOLLOWS:
*D*                  00 IF NORMAL EXIT
*D*                  04  IF ERROR
*D*                  06 IF ABORT
*D*
SETSTCC  EQU      %
         LI,1     BA(JB:STEPCC)
         LB,2     J:RNST
         CI,2     X'5F'             CHK ABORT
         BAZ      CCIN1
         LI,15    6
CCIN0    CB,15    0,1
         BLE      CCIN2             FOR HI WATER MARK
         STB,15   0,1               NEW STEP CC
CCIN1    LI,15    4                 ERROR CC
         CI,2     X'A0'             CHK ERROR
         BANZ     CCIN0             YES
CCIN2    EQU      %
         LI,7     X'1FFFF'          WAS CAL WITH ECB IN PROGRESS?
         AND,7    J:RWECB
         BEZ      NOTXECB           --> NO.
         LI,6     0                 YES.  ZERO OUT
         STS,6    J:RWECB             ADDRESS OF ECB BLOCK.
XECB01   MTB,0    *7                IS I/O ALL DONE?
         BEZ      XECB02            --> YES.
         LI,6     E:QMF             NO.
         BAL,11   T:REG             WAIT A WHILE.
         B        XECB01            TRY AGAIN.
XECB02   LW,8     S:CUN
         LW,9     2,7
         LW,10    1,7
         BAL,11   ECBPOST1          POST THE ECB.
*D*
*D*               THE ABORT CODES IN R14 ARE STORED IN THE JIT
*D*               UNLESS WE GOT THE ERROR ATTEMPTING TO ASSOCIATE
*D*               TEL TO GIVE AN ON-LINE USER RUNNING IN THE EXTENDED
*D*               MEMORY MODE AN ERROR MESSAGGE.  IN THIS CASE THE
*D*               ORIGINAL ERROR CODES ARE LEFT IN JIT.
*D*
NOTXECB  RES      0
         LI,3     X'1FFFF'
         CW,14    TELABORT          EXTENDED ON-LINE USER ABORT
         BE       %+3               YES
         CW,14    ACPABORT          OVERLAPPING SHRD PROC. ABORT
         BNE      %+3               NO
         MTB,0    J:ABC             BUT ABORTING FOR ANOTHER REASON
         BNEZ     %+4               YES-DONT DESTROY ORIGINAL ERR CODE
         STB,14   J:ABC             R14 CONTAINS ERROR CODE
         LB,2     14                SUBCODE,IF ANY
         STS,2    J:JIT+ERO          INTO JIT
         LW,4     S:CUN
         LH,15    UH:FLG,4
         CI,15    TIC               DID COMMAND PROC EXIT/ABORT
         BANZ     XCONSEE           YES
         CI,15    DELA              IS DELTA ASSOCIATED
         BAZ      XCONSEE           NO
         CI,15    DIC               DID DELTA EXIT/ABORT
         BANZ     XCONSEE           YES
         LI,10    SPPBASE+X'E'      NO-GO GET DELTA
         B        DELDEST
*D*
*D*               IF THE USER HAS REQUESTED EXIT CONTROL A CHECK IS
*D*               MADE TO DETERMINE IF THE EXIT LOGIC WAS ENTERED VIA
*D*               AN M:EXIT, M:ERR OR M:XXX FROM THE USER'S EXIT
*D*               CONTROL ROUTINE.  IF SO THE EXIT CONTROL LOGIC
*D*               IS SKIPPED.
XCONSEE  EQU      %
         LB,1     J:RNST            R1= J:RNST(0-7).
         LB,2     J:EXTENT          R2= J:EXTENT(0-7).
         AND,3    J:EXTENT            SEE IF XCON ADDRESS SPECIFIED.
         BEZ      NOXCON            --->NO.
         CI,2     X'20'               SEE IF XCON IN PROGRESS.
         BAZ      NOTINPRO          --->NO.
         CI,1     X'3F'               SEE IF M:EXIT/ERR/XXX IN XCON.
         BANZ     NOTINPRO          *
         LI,6     BA(JB:FRS)        * RESET USERS RUNSTATUS
         LB,6     0,6               *
         STB,6    J:RNST            * AND CONTINUE
         B        NOXCON            *
NOTINPRO EQU      %
*D*
*D*               MUST HAVE EQUIVALENCE BETWEEN USER'S TEL-IN-CONTROL
*D*               AND THE SET-BY-TEL BIT IN J:EXTENT, OR NO XCON.
*D*                                 REGS=(1=J:RNST0-7,2=J:EXTENT0-7,
*D*                                       4=S:CUN,15=UH:FLG)
         CI,15    TIC
         BAZ      NOTCP
         CI,2     X'10'
         BANZ     XCONGO            --->TIC + XCON-BY-TEL.
         AND,2    XFFFD             INSURE USER RUNDOWN AFTER HANGUP
         STB,2    J:EXTENT          WITH TEL IN CONTROL.
         LI,2     19                BUILD ENVIRONMENT.
         MSP,2    TSTACK
         LI,1     0
         LW,2     TSTACK
         STW,1    -9,2
         B        STEP00
*
*
NOTCP    CI,2     X'10'
         BANZ     NOXCON            --->NOT-TIC + XCON-BY-TEL.
XCONGO   EQU      %                 ---V NOT-TIC + XCON-NOT-BY-TEL.
*D*
*D*               THE USER HAS EXIT CONTROL AND ISN'T DOING THE FINAL
*D*               EXIT FROM AN EXIT CONTROL ROUTINE.
*D*               EXITS ARE DIVIDED INTO THREE CLASSES --
*D*               III. OPERATOR ABORT / LINE HANGUP.
*D*                II. LIMIT EXCEEDED.
*D*                 I. OTHER. (M:EXIT/ERR/XXX,IOERR,TRAP,OPERATOR E).
*D*               PREVIOUS TYPE II/III HAVE SET BITS IN J:EXTENT --
*D*                Y8. A TYPE-III EXIT OCCURRED.
*D*                Y4. USER WAS GIVEN EXTENDED PROCESSING LIMITS.
*D*               PROCESSING IS AS FOLLOWS FOR VARIOUS COMBOS --
*D*                 I. ->XCON.
*D*                II.Y8 ->ZAP USER.
*D*                   Y4 ->ZAP USER EXCEPT ONLINE, WHO GO TO TEL.
*D*                   -- SET Y4, EXTEND LIMITS, ->XCON.
*D*               III.Y8 ->ZAP USER.
*D*                   Y4 SET Y8, ->XCON.
*D*                   -- SET Y8, SET Y4, EXTEND LIMITS, ->XCON.
*D*               (TIME LIMIT EXTENDED ONLINE ONLY FOR TYPE-III EXIT)
*D*                                 REGS=(R1=J:RNST0-7,R2=J:EXTENT0-7,
*D*                                       R4=S:CUN,R15=UH:FLG)
         CI,1     X'1C'
         BAZ      XCONSET           --->  I. GO TO USER XCON.
         CI,2     X'80'
         BANZ     KICKOFF           --->II/III ON III. ZAP USER.
         CI,1     X'18'
         BAZ      XCONLIMS
         OR,2     X80                   III ON I/II. SET 'III'.
         CI,2     X'40'
         BANZ     XCONSET           --->III ON II. GO TO USER XCON.
         B        TIMELMT           --->III. BUMP LIMS & GO TO XCON.
XCONLIMS CI,2     X'40'
         BANZ     XCONKICK          --->II ON II. ZAP OR TEL USER.
         LC       J:JIT                 II.
         BCS,8    LMTINC            --->  BUMP ALL BUT TIME ONLINE.
*                                   ---V  BUMP ALL NON-ONLINE.
*                                                                FIELD
TIMELMT  LW,6     SL:ETIME
         AWM,6    J:MRT             INCR. MAX TIME LEFT TO RUN   0-31
LMTINC   LW,6     SL:ELO
         AWM,6    J:JIT+MPPO        INCR. LO                     0-14
         LW,6     SL:EPO
         AWM,6    J:JIT+MPO         INCR. PO                     0-14
         LW,6     SL:EDO
         AWM,6    J:JIT+MDPO        INCR. DO                     0-14
         LW,6     SL:EUO
         AWM,6    J:JIT+MUPO        INCR. UO                     0-14
         LW,6     SL:ETS
         AWM,6    J:JIT+TMDCRM      INCR. TSTORE (RAD)           0-31
         AWM,6    J:JIT+TMDPRM      INCR. TSTORE (PACK)          0-31
         AWM,6    J:JIT+TMPDCPK     INCR. TSTOREMAX (RAD)        0-31
         AWM,6    J:JIT+TMPDPPK     INCR. TSTOREMAX (PACK)       0-31
         LW,6     SL:EPS
         AWM,6    J:JIT+PRDCRM      INCR. PSTORE (RAD)           0-31
         AWM,6    J:JIT+PRDPRM      INCR. PSTORE (PACK)          0-31
         LI,7     X'1FFFF'
         STS,6    J:JIT+ALOCCT      REMEMBER PSTORE INCR. VALUE  15-31
         OR,2     X40               SET 'LIMIT-INC' FOR ACCTSUM.
XCONSET  STB,2    J:EXTENT          UPDATED FLAGS TO J:EXTENT.
*D*
*D*               XCONSETUP IS ENTERED TO TRANSFER CONTROL TO THE
*D*               USER'S EXIT-CONTROL ROUTINE.
*D*               TSTACK IS FORCED TO ONE ENVIRONMENT, WHICH IS
*D*               COPIED TO THE USER'S TCB STACK IF ROOM & IF STACK
*D*               IS GOOD; OTHERWISE THE EXIT/ABORT PSD IS PLACED IN
*D*               USER'S REGISTERS R2/R3.
*D*                                 REGS=NONE.
XCONSETUP EQU     %                 HONOR THE EXIT CONTROL
         LD,2     19PSD             FORCE STACK DOWN TO
         STD,2    TSTACK            ONLY ONE ENVIRONMENT.
         LW,1     J:TCB             R1 = USER STACK ADDR FOR UTSXTS.
         BAL,4    T:UTSXTS          COPY TSTACK TO USER STACK.
         B        TCBMESS           ---> USERSTAK IS EVIL.
         LI,1     0                   (INDICATE USER STACK IS GOOD)
         B        TCBEND
TCBMESS  LW,3     TSTACK
         AI,3     -17               3 POINTS TO MID-PSD IN TSTACK.
         LD,6     *3
         STW,6    4,3               R2 IN TSTACK:  USER'S PSD AT
         STW,7    5,3               R3 IN TSTACK:  TROUBLE TIME.
         LW,1     Y8                  (INDICATE USER STACK IS BAD)
TCBEND   STW,1    12+2,3              (R12 BIT0 SAYS GOOD/BAD USERSTAK)
*D*
*D*               THE USER'S EXIT CONTROL ADDRESS IS BUILT INTO A PSD,
*D*               HIS REGISTERS ARE SET UP (SEE BATCH PROCESSING
*D*               REFERENCE MANUAL), J:RNST, J:ABC, AND ERO ARE CLEARED
*D*               AND THE EXIT CONTROL IN PROGRESS BIT IS SET. CONTROL
*D*               THEN TRANSFERS TO THE USER AT HIS EXIT CONTROL ADDRESS.
*D*
         LI,10    X'1FFFF'
         AND,10   J:EXTENT          GET USER'S EXIT-CONTROL ADDRESS.
         AW,10    SMPSD             BUILD A REALLY GOOD PSD
         LW,11    SMPSD+1             AROUND IT.
         STD,10   *3                FIX TO GO THERE.
         LW,7     3
         LB,14    J:RNST
         STW,14   10,7              R8,BITS 24-31=RUNSTATUS FLGS
         LI,1     0
         STB,1    J:RNST            CLEAR RUN STATUS
         LI,14    X'1FF'            * MASK FOR LIMIT BITS
         AND,14   J:ASSIGN          * AND'ED INTO R14
         STW,14   11,7              * AND PLACED IN STACK
         LB,14    J:ABC
         STW,14   12,7              R10=ERR CODE
         STB,1    J:ABC             CLEAR ERR CODE
         LI,15    X'FF'
         LS,14    J:JIT+ERO
         STW,14   13,7              R11=ERR SUBCODE
         LI,14    0
         STS,14   J:JIT+ERO         CLEAR ERR SUBCODE
         LB,14    J:EXTENT          SEE IF EXIT IS FROM M:LINK
         LI,1     X'20'
         OR,14    1
         STB,14   J:EXTENT          SET IN-PROGRESS BIT IN J:EXTENT
         CI,14    8
         BAZ      XCONENT
         AND,14   XFFF7
         STB,14   J:EXTENT          RESET THE BIT IN J:EXTENT
         LW,1     Y4
         STS,1    14,7              BIT 1 IN R12=1 ,M:LINK EXIT
XCONENT  EQU      %
         LI,14    0
         STW,14   J:INTENT          RESET INT. ENTRY
         STW,14   J:TIMENT          RESET TIMER CONTROL
         LW,4     S:CUN             * GET CUN
         LH,1     UH:FLG,4          * AND HIS FLAGS
         CI,1     DIC               * DELTA AROUND?
         BAZ      SSEMDEST          * NOPE....DIE
         AI,1     -DIC              * RESET DIC
         STH,1    UH:FLG,4          * AND TELL TEL
         LB,1     UB:ASP,4          * HOW ABOUT SHARED LIBRARY
         BEZ      SSEMDEST          * NOPE -> DIE
         MTB,1    PB:UC,1           * ALTER THE APPROPRIATE COUNTS
         LB,1     UB:DB,4           *
         MTB,-1   PB:UC,1           *
         B        SSEMDEST          * GO INTO THE INFERNAL PIT
         PAGE
*D*
*D*               EXIT CONTROL IS NOT BEING ENTERED.
*D*               IF WE ARE EXITING FOR OPERATOR ABORT OR LINE HANGUP,
*D*               GO TO T:RUNDOWN TO RUN DOWN AND KILL THE USER.
*D*               IF NOT, BUT ABORT/HANGUP WAS PREVIOUSLY GIVEN TO
*D*               EXIT CONTROL, HAVE XCONKICK KILL THE USER.
*D*                                 REGS=(1=J:RNST0-7,2=J:EXTENT0-7,
*D*                                       4=S:CUN,15=UH:FLG)
NOXCON   EQU      %
         CI,1     X'18'
         BANZ     T:RUNDOWN         --->GO KILL X'ED OR HUNGUP USER.
         CI,2     X'80'             *
         BANZ     XCONKICK          --->GO KILL PREV X/HUNGUP USER.
*D*
*D*               IF THE USER'S PROGRAM WAS M:LINK'ED TO WITH (EXIT)
*D*               SPECIFIED, NOW IS THE TIME TO RETURN TO THE LINKER.
*D*
         LW,0     J:RNST
         CI,0     X'6000'
         BAZ      ASISNOW           --->NO LDTRC ON EXIT/ERR SPEC.
         CI,0     X'FF'
         BAZ      ASISNOW           --->NO M:LINKS DONE SO NO LDTRC.
         CW,0     YFF
         BAZ      LDTGO             --->M:EXIT ALWAYS IS M:LDTRC.
         CI,0     X'4000'
         BAZ      ASISNOW           --->NON-EXIT & NOT ERR SPEC.
         CW,0     YC
         BAZ      ASISNOW           --->ERR SPEC BUT NOT M:ERR/M:XXX.
LDTGO    BAL,1    RTCHK
         BCS,4    ASISNOW           --->LOCKED IN CORE = IGNORE.
         BAL,1    RSTRTN              CLEAR RNST FLAGS NOW.
         LI,0     0
         STB,0    J:RNST              ZERO OUT RNST BYTE.
         OVERTO   LDLNKSEG,LDTSETUP# --->GO DO FAKE M:LDTRC.
*D*
*D*               XCONKICK IS ENTERED WHEN A USER HAS EXCEEDED
*D*               THE LIMITS ESTABLISHED FOR EXIT CONTROL.  IF THE
*D*               USER IS A BATCH OR GHOST USER, OR AN ON-LINE USER
*D*               THAT IS BEING ABORTED BY THE OPERATOR OR BECAUSE OF A
*D*               LINE HANG-UP, CONTROL TRANSFERS TO T:RUNDOWN WITH
*D*               J:RNST SET TO '18'.  OTHERWISE THE ABORT CODE,
*D*               J:ABC, IS SET TO 'AD' , THE USER IS RUN DOWN AND
*D*               RE-ASSOCIATED WITH TEL.
*D*                                 REGS=(1=J:RNST0-7,2=J:EXTENT0-7,
*D*                                       4=S:CUN,15=UH:FLG)
XCONKICK EQU      %
         CI,2     X'80'
         BANZ     KICKOFF           --->KILL OPERATOR-X'ED USER.
         LC       J:JIT
         BCS,8    %+2               * DRIVE FOR ONLINE USER
         BCR,8    KICKOFF           --->KILL NON-ONLINE USER.
*E*      ERROR:   AD-00
*E*      MESSAGE: EXTENDED PROCESSING LIMITS WERE EXCEEDED
         LI,2     X'AD'             LET TEL OUTPUT MSG
         LI,3     X'1FFFF'          'EXTENDED LIMITS EXCEEDED'
         STB,2    J:ABC
         LB,2     2
         STS,2    J:JIT+ERO
         B        ASISNOW
KICKOFF  EQU      %
         LI,1     X'18'             BOTH BITS SET IN J:RNST
         STB,1    J:RNST            TO INDICATE XCON ONCE IN EFF.
         B        T:RUNDOWN
*D*
*D*               XCON NOT BEING ENTERED, NO CURRENT OR PREVIOUS
*D*               OPERATOR ABORT OR LINE HANGUP, AND M:EXIT IS NOT
*D*               TO BE TREATED AS M:LDTRC.
*D*               CLEAR THE EXIT-IS-LDTRC FLAGS.
*D*               IF A GHOST ABORTED BY TRAP, TELL THE OPERATOR.
*D*
*D*               IF A COMMAND PROCESSOR ABORTED, GO TO T:RUNDOWN.
*D*               IF AN ONLINE USER ABORTED, GO TO T:ECCP TO GET
*D*                                 THE USER'S COMMAND PROCESSOR.
*D*               OTHERWISE GO TO RUN DOWN THE USER PROGRAM @ RUND.
*D*                                 REGS=(4=S:CUN,15=UH:FLG)
ASISNOW  EQU      %
         BAL,1    RSTRTN            EXIT-IS-LDTRC N/A NOW.
         LD,2     38PSD
         STD,2    TSTACK
         LB,1     J:RNST            R1= J:RNST(0-7).
         BEZ      RUND              --->EXIT MEANS RUN DOWN.
         CI,1     1
         BNE      NOTGHST
         LC       J:JIT
         BCR,4    NOTGHST
         OVERLAY  MISOVSEG,T:GHOST#  TELL OPERATOR THAT GHOST TRAPPED.
         B        RUND              --->THEN RUN DOWN GHOST.
NOTGHST  CI,15    TIC
         BANZ     T:RUNDOWN         --->CP ABORT. ZAP OR RUN DOWN.
         LC       J:JIT
         BCR,8    RUND              --->NON-ONLINE ABORT. RUN DOWN.
         B        T:ECCP            --->ONLINE ABORT. GO GET TEL.
         TITLE    'USER RUNDOWN'
         PAGE
*F*
*F*      NAME:    T:RUNDOWN
*F*
*F*      PURPOSE: TO CLEAN UP PROCESSING THE USERS LATEST JOB-STEP
*F*               AND TRANSFER CONTROL TO THE APPROPRIATE ROUTINE
*F*               TO INITIATE THE NEXT JOB STEP.
*F*
*F*      DESCRIPTION: T:RUNDOWN STRIPS A USER DOWN TO HIS JIT, AJIT
*F*               AND COOP BUFFERS SO THAT HE IS READY FOR THE
*F*               NEXT JOB STEP.
*F*
*F*               ANY ASSOCIATED SHARED PROCESSORS ARE DISASSOCIATED.
*F*               DEBUG-SEG IS CALLED TO OUTPUT PMD'S IF REQUIRED;
*F*               ANY DCBS THAT WERE LEFT OPEN ARE CLOSED.  THE
*F*               USERS PAGES ARE RETURNED TO THE SYSTEM; ANY ASSOCIATED
*F*               SHARED PROCESSOR PROCEDURE PAGES ARE REMOVED FROM HIS MAP.
*F*               THE JIT IS REINITIALIZED.  CONTROL THEN TRANSFERS TO
*F*               T:ECA TO GIVE CONTROL TO THE USER'S COMMAND PROCESSOR.
*F*
*D*      NAME:    T:RUNDOWN
*D*
*D*      CALL:    ENTERED FROM THE COMMON EXIT LOGIC, SETRNST.
*D*
*D*      DESCRIPTION:
*D*               IF THE USER HAS BEEN ABORTED DURING THE REINITIALIZATION
*D*               LOGIC, AS INDICATED BY S:CUN = S:CRASHUN, HE MUST
*D*               BE DELETED FROM THE SYSTEM AS HE IS TOO DAMAGED TO
*D*               RUN DOWN GRACEFULLY.
*D*
T:RUNDOWN EQU     %
         LW,4     S:CUN
         LB,15    J:RNST
         BEZ      RUND1+1
         CW,4     S:CRASHUN
         BNE      RUND1
         LI,15    0
         STW,15   S:CRASHUN
         B        T:DELUSZAP
*D*
*D*               OTHERWISE THE CURRENT S:CUN REPLACES S:CRASHUN.
*D*
RUND1    STW,4    S:CRASHUN
         LH,15    UH:FLG,4
*D*
*D*               THE STEP IN PROGRESS BIT IS SET IN UH:FLG TO SIGNAL
*D*               THE SCHEDULAR TO SPEED THE I/O PROCESS BY PLACING
*D*               THE USER IN THE SPECIAL COMPUTE QUEUE UPON COMPLETION
*D*               OF EVERY I/O OPERATION OR QUANTUM END.  THIS LOWERS THE
*D*               POSSIBILITY OF THE USER BEING SWAPPED DURING THE
*D*               STEP PROCESS.
*D*
RUND     RES      0
         OR,15    X4000
         STH,15   UH:FLG,4
         CW,4     DID
         BNE      %+3
         LI,0     0
         STW,0    DID
*D*
*D*               TSTACK IS FORCED TO A SINGLE ENVIRONMENT TO
*D*               FACILITATE POSSIBLE ERROR MESSAGES
*D*
         LD,0     19PSD
         STD,0    TSTACK
*D*
*D*               IF THERE HAS BEEN ANY REAL-TIME ACTIVITY BY THE USER
*D*               RTNR SEG IS CALLED FOR REAL-TIME RUNDOWN.
*D*                                 TSTACK=19. REGS=NONE.
         LW,2     J:ICBHDR          ANY REAL-TIME ACTIVITY BY USER?
         BGEZ     RND1              NO
         OVERLAY  RTNRRTSEG,RTRNDWN#   YES...GO RUN DOWN RT ACTIVITY
RND1     EQU      %
*D*
*D*               IF A SYMBIONT FILE WAS BEING BUILT (VIA M:JOB),
*D*               T:JECLS IS CALLED TO RELEASE THE PARTIAL FILE.
*D*                                 TSTACK=19. REGS=NONE.
         LI,6     X'FFFF'           IS A JOBENT IN PROGRESS...
         AND,6    J:JIP                (IF SO, R6=DA(DCB).)
         BEZ      RND2              --->NO.
         OVERLAY  MISOVSEG,T:JECLS#     YES. PURGE PARTIAL FILE.
RND2     EQU      %
*D*
*D*               IF A NON-ONLINE USER ABORTED OR HAS PMD'S,
*D*               DEBUGSEG IS CALLED TO PRINT ABORT REASON AND PMD.
*D*                                 TSTACK=19. REGS=NONE.
         LC       J:JIT
         BCS,8    RND3              --->NO DEBUGS; ONLINE USER.
         LB,0     J:RNST
         BNEZ     RND3DB            --->DEBUGS; USER ABORTED.
         LI,0     X'20000'
         CW,0     J:ASSIGN
         BAZ      RND3              --->NO DEBUGS; NO ABORT OR PMD.
RND3DB   OVERLAY  DEBUGSEG,2          GO DO ERRORMESSAGE & PMDS.
RND3     EQU      %
*D*
*D*               IF THE USER DID ANY TRANSACTION PROCESSING CALLS,
*D*               TQOV1SEG IS CALLED TO PURGE THE T-P TABLES.
*D*                                 TSTACK=19. REGS=NONE.
         LW,7     Y004
         CW,7     J:ASSIGN
         BAZ      RND4              --->NO T-P CALLS DONE.
         LW,7     Y006
         PUSH     7                 SET 'PURGE-ALL' FLAG.
         LI,6     0                 SET LIST-ID = 0.
         LW,7     TSTACK            SET R7=> FAKE FPT.
         LI,8     X'0B'             SET R8= M:QUEUE(PURGE) FPT CODE.
         OVERLAY  TQOV1SEG,0
         PULL     7
RND4     EQU      %
*D*
*D*               THE USE COUNT (PB:UC) OF THE USER'S CURRENT
*D*               SHARED PROCESSOR(S) IS DECREMENTED BY DTORP.
*D*                                 TSTACK=19. REGS=NONE.
         LW,4     S:CUN             R4= USER NUMBER.
         BAL,2    DTORP             SETS R15=USER FLAGS.
*D*               R1=USER ACP/ASP/DB, DEPENDING ON WHO IN CONTROL.
*D*                  (REMEMBER IT IN CASE ASP WAS LINK)
         LW,7     1
*D*
*D*               NOW CALL RPROCS TO DECREMENT PB:REP FOR ALL
*D*               SHARED PROCESSORS (EXCEPT C.P.) AND CLEAR THEM
*D*               OUT OF USER TABLES.  ALSO CLEAR UH:FLG OF ALL
*D*               PROCESSOR-IN-CONTROL BITS.
*D*                                 TSTACK=19. REGS=(R4=S:CUN,
*D*                                      R7=ACP/ASP/DB,R15=UH:FLG)
         BAL,2    RPROCS
         RSETS    TIC               CLEAR 'COMMAND-PROC-IN-CONTROL'
         RSETS    DIC               CLEAR 'DELTA-IN-CONTROL'
         RSETSST  DELA              CLEAR 'DELTA-ASSOCIATED'
*D*
*D*               J:RNST IS THEN SET TO 'MONITOR-RUNNING'.
*D*                                 TSTACK=19. REGS=(R7=ACP/ASP/DB)
         LI,0     0
         LW,1     Y003E
         STS,0    J:RNST            SET 'MONITOR-RUNNING'.
*D*
*D*               ALL USER DCBS ARE NOW CLOSED.
*D*                                 TSTACK=19. REGS=(R7=ACP/ASP/DB)
         BUMP     -19,6             CLEAR OUT TSTACK.
         BAL,0    CLSDCBS           CLOSE ALL DCBS.
XIT50    EQU      %
*D*
*D*               RESET AN ON-LINE USER'S M:UC ASN TO 3.
*D*               RESET THE DEFAULT PROMPT CHARACTER
*D*               RESET THE ACTIVATION CHARACTER SET.
*D*                                 TSTACK=0.  REGS=(R7=ACP/ASP/DB)
         LW,4     S:CUN
         LH,15    UH:FLG,4
         CI,15    BAT
         BANZ     XIT51
         LI,6     3
         STB,R6   M:UC,R6           SET ASN IN M:UC TO 3
         BAL,R5   COCGLN            GET LINE # IN R2, CHECK
         B        XIT51             RETURN POINT IF NOT ONLINE OR # BAD
         LI,R5    BA(JB:DPROMPT)    L/BA OF DEFAULT PROMPT CHARACTER
         LB,R13   0,R5              L/DEFAULT PROMPT CHAR
         LI,R5    BA(JB:PROMPT)     L/BA OF CURRENT PROMPT CHARACTER
         STB,R13  0,R5              S/DEFAULT AS CURRENT PROMPT CHAR
         DISABLE                    INHIBIT
         LB,R13   MODE2,R2          L/MODE2
         AND,R13  XFC               &/MODE2 W/.FC; RESET ACTIV CHAR SET
         STB,R13  MODE2,R2          S/MODE2
         ENABLE
XIT51    EQU      %
*D*
*D*               ALL PAGES EXCEPT THE USER'S JITS AND COOP BUFFERS
*D*               ARE RETURNED TO THE SYSTEM.
*D*
*D*               THE USER'S VIRTUAL MAP CHAIN IS USED TO REMOVE
*D*               ALL CORRESPONDING PAGES IN JX:CMAP EXCEPT FOR THE
*D*               FILE MANAGEMENT BUFFERS AND COOP BUFFERS.  EACH
*D*               VIRTUAL PAGE TO RELEASE IS DETERMINED BY LINKING
*D*               THROUGH JB:LMAP STARTING WITH JB:VLH.  IF THE PAGE
*D*               OBTAINED IS NOT BELOW BUP, MEANING IT IS NOT A JIT
*D*               OR SPARE BUFFER PAGE, IT IS RELEASED VIA THE MM ROUTINE
*D*               T:RVPI (RELEASE VIRTUAL/PHYSICAL) AND THE NEXT PAGGE
*D*               OBTAINED.
*D*
*D*               THIS REMOVES ALL USER DATA, DCB, PROCEDURE AND
*D*               DYNAMIC DATA PAGES; IF A SHARED PROCESSOR HAD
*D*               BEEN ASSOCIATED IT REMOVES ALL SHARED PROCESSOR
*D*               DATA, DCB AND DYNAMIC DATA PAGES
*D*
XIT52    EQU      %
         LB,10    JB:VLH            HEAD OF VIRTUAL PAGE LINK
         LI,8     JBUPVP-1          UPPER LIMIT OF BUFFER WINDOW
XIT710   EQU      %
         LW,7     10                 NEXT PAGE TO RELEASE
         BEZ      XIT720             DONE IF ZERO
         LB,10    JB:LMAP,7         GET LINK TO NEXT PAGE
         CW,7     8                 IS THIS VP A SPARE BUFFER
         BLE      XIT710            YES-DONT RELEASE NOW
         LW,11    J:ICBHDR          XITING LOCKED IN CORE?
         BLZ      XIT715            YES...SPECIAL CASE
XIT711   EQU      %
         BAL,11   T:RVPI            NO, RELEASE VIRTUAL PAGE
         NOP                         IGNORE ERROR RETURN
         B        XIT710             CYCLE TILL DONE
XIT715   CLM,7    J:BUP             BUP -- EUP
         BCS,9    XIT711            RELEASE IT NORMALLY IF NOT BETWEEN
*                                   BUP AND EUP
         CLM,7    J:DCBLL           DCBLL -- DCBUL
         BCR,9    XIT711            RELEASE IT NORMALLY IF DCB PAGE
         MTW,-1   S:ACORE           TAKE IT OUT FOREVER
         MTW,-1   S:PCORE           HERE TOO
         BAL,11   T:RVSPI           DON'T RELEASE PHYSICAL PAGE
         B        XIT710
*
*D*
*D*               ALL F CMAP AND LMAP CELLS BETWEEN THE BEGINNING
*D*               AND THE END OF VIRTUAL CORE  ARE SET TO FPMC AND
*D*               ZERO RESPECRIVELY.  THE MM ROUTINE T:SAC IS CALLED
*D*               FOR EACH PAGE TO INSURE ACCESS IS SET TO 11.
*D*
*D*               THIS RESETS ALL SHARED PROCESSOR PROCEDURE AND
*D*               RELEASES ANY PAGES OBTAINED BY THE M:CVM CAL.
*D*
XIT720   LI,10    0
         STW,10   J:TREE            RESET TREE FOR NANCY
         LI,4     3                 ACCESS CODE
         LI,9     FPMC
         LW,7     J:BUP
XIT8     STORE,9  JX:CMAP,7
         STB,10   JB:LMAP,7
         BAL,2    T:SAC
         AI,7     1
         CI,7     X'FF'
         BLE      XIT8
*D*
*D*
*D*               THE T:RSTLMS SUBROUTINE IS CALLED TO RESET JIT MEMORY
*D*               DELIMITERS TO THEIR INITIAL VALUES.
*D*
         BAL,4    T:RSTLMS
*D*
*D*               USER RE-INITIALIZATION CONTINUES AT LDLNK WHICH
*D*               CHECKS FOR THE EXISTENCE OF ANY TEMPORY FILES
*D*               BUILT BY THE LNKTRC OVERLAY FOR AN M:LINK CAL.
*D*               IF THE LOW ORDER BYTE OF J:RNST IS NON-ZERO (THE
*D*               COUNTER FOR LNKTRC FILES), CONTROL IS PASSED
*D*               TO THE LNKTRC OVERLAY AT ITS CLEANUP ENTRY POINT.
*D*
LDLNK    LI,8     X'FF'
         AND,8    J:RNST
         BEZ      XIT85
         OVERLAY  LDLNKSEG,LEXIT#
*D*
*D*               THE T:ZBUF ROUTINE IN MM IS CALLED TO RELEASE THE
*D*               FILE MANAGEMENT BUFFERS.  COOP BUFFERS ARE NOT
*D*               RELEASED BY T:ZBUF.
*D*
XIT85    BAL,6    T:ZBUF            RELEASE ALL FPOOLS
*D*
*D*               OTHER JIT CELLS REFERRING TO LOCATIONS IN THE
*D*               RELEASED MEMORY AREA ARE ZEROED.  THE TEL FLAG,
*D*               EXTEND, IS RESET.  J:EUP IS SET TO THE FIRST PAGE
*D*               BELOW THE SPECIAL PROCESSOR AREA.
*D*
         LI,10    0                 RESET JIT
*BIT 0/1 RETAINED FROM JOB STEP TO JOB STEP
         LW,11    MASKS+30          SAVE BITS 0 AND 1
         STS,10   J:EXTENT
         STW,10   J:TCB
         STW,10   J:DCBLINK
         STW,10   J:INTENT
         STW,10   J:TIMENT
         STW,10   J:USENT
         STW,10   J:ICBHDR
         STW,R10  J:UPRIV
         LW,11    EXLYMSK
         STS,10   J:EXLY
         LC       J:JIT
         BCR,8    XIT730            DO FOR ON-LINE USER ONLY
         LW,11    Y00200002         RESET EXTENDED CORE FLAG
         STS,10   J:TELFLGS
XIT730   EQU      %
         LI,11    X'FFF00'
         STS,10   JB:PCP
         LW,11    Y8
         STS,10   J:ASSIGN
XIT9     LI,2     JEUPVP            RE-INITIALIZE WITH SPECIAL PROCESSOR
         STW,2    J:EUP                AREA HELD IN RESERVE
         STW,2    J:DDUL
         LI,3     JBBCP
         STB,2    JIT,3             BEGINNING COMMON PAGE
*D*
*D*               THE USER NOW CONSISTS OF ONLY HIS JIT, HIS AJIT
*D*               IF ANY, AND HIS COOP BUFFERS.  HE HAS BEEN
*D*               RE-INITIALIZED IN THE NON-EXTENDED MEMORY MODE.
*D*
         LW,4     S:CUN
         LRSETSST TIC
*D*
*D*               IF THERE ARE ANY OUTSTANDING ENQUEUE CALS, A
*D*               DEQUEUE CAL IS SIMULATED.
*D*
         LI,0     X'100'            JIT:ENQ BIT
         CW,0     J:ABC
         BAZ      NOENQ
         LW,7     TSTACK
         AI,7     1                 ADJUST TO WORD 1 OF FPT
         LCI      4                 PUT FPT WORDS 1-4 INTO TSTACK
         LM,15    NQSFPT              WORD 0 IS NOT USED
         PSM,15   TSTACK
         LI,8     9                 DEQUEUE FPT CODE
         BAL,11   ENQ
ENQPUL   BUMP     -4,1
*D*
*D*               THE NUMBER OF JOB STEPS COUNT (JB:STEP) IS
*D*               INCREMENTED AND CONTROL TRANSFERS TO T:ECA TO
*D*               ASSOCIATE AND ENTER THE USER'S COMMAND PROCESSOR.
*D*
NOENQ    EQU      %
         LI,4     0
         STW,4    S:CRASHUN
         MTB,1    JB:STEP           COUNT UP JOB STEPS
         LW,4     S:CUN
         B        T:ECA             GET TEL
         TITLE    'ASSOCIATE COMMAND PROCESSOR'
*F*
*F*      NAME:    T:ECCP
*F*
*F*      PURPOSE: ASSOCIATE COMMAND PROCESSOR LOGIC
*F*
*F*      DESCRIPTION:  THE CURRENT JOB-STEP IS RUN DOWN IF NECESSARY
*F*               TO DO SO TO ASSOCIATE THE COMMAND PROCESSOR.
*F*
*F*               IF THERE IS NO COMMAND PROCESSOR ASSOCIATED WITH THE
*F*               USER, OR IF AN ON-LINE USER IS BEING ABORTED BECAUSE
*F*               OF AN OPERATOR KEY-IN OR A LINE HANG-UP, LOGON IS
*F*               ASSOCIATED TO DELETE THE USER FROM THE SYSTEM
*F*               VIA THE ASSOCIATE PROGRAM LOGIC, T:ASP.
*F*
*F*               OTHERWISE, THE COMMAND PROCESSOR NUMBER IS LOADED INTO
*F*               R5 AND THE ASSOCIATE PROGRAM LOGIC IS ENTERED AT ASP1.
*F*
*D*      NAME:    T:ECCP
*D*
*D*      CALL:    ENTERED FROM THE T:RUNDOWN LOGIC TO ASSOCIATE THE
*D*               USER'S COMMAND PROCESSOR FOR THE NEXT JOB STEP.
*D*
*D*               ENTERED FROM AN ABORT SITUATION TO ASSOCIATE THE
*D*               TEL COMMAND PROCESSOR TO GIVE THE ON-LINE USER
*D*               AN ERROR MESSAGE.
*D*
*D*               ENTERED FROM THE 'SCHED' MODULE TO ASSOCIATE TEL
*D*               WHEN AN ON-LINE USER HAS TYPED CONTROL-Y OR HAS
*D*               HIT BREAK.
*D*
*D*      DESCRIPTION:  IF THE COMMAND PROCESSOR IS NOT A SPECIAL
*D*               SHARED PROCESSOR, OR IF IT HAS DCBS, THE CURRENT
*D*               JOB STEP MUST BE RUN DOWN TO MAKE ROOM FOR THE
*D*               COMMAND PROCESSOR.
*D*
T:ECCP   EQU      %
         LW,4     S:CUN
         LB,5     UB:ACP,4          GET CMND PROC #
         LW,2     P:SA,5            IS IT TEL OVERLAY
         CW,2     Y4
         BAZ      RUND              NO,BUMP AND RUND
         LB,2     PB:DCBSZ,5        YES, DOES IT HAVE DCBS
         BNEZ     RUND
*D*
*D*               IF CALLING A C.P. FOR AN ON-LINE USER IN THE
*D*               EXTENDED MEMORY MODE THE USER IS ABORTED (A5-04).
*D*
*E*      ERROR:   A5-04
*E*      MESSAGE: EXTENDED MEMORY MODE-CURRENT JOB STEP ABORTED
*E*
         LI,14    X'A504'           ERR CODE FOR EXTENDED USER ABORT
         SCS,14   -8
         LW,2     J:TELFLGS
         CW,2     Y002              ABORT EXTENDED USER
         BAZ      ECCP2             NOT EXTENDED
ECCP1    LB,2     J:RNST            IS HE ALREADY IN TROUBLE
         BNEZ     RUND              YES-DONT CHANGE ERR MSG
         B        T:ABORTM          NO-CY OUT OF EXTENDED MEMORY MODE
*E*
*E*      ERROR:   A5-06
*E*      MESSAGE: CURRENT SPECIAL SHARED PROCESSOR ABORTED FOR TEL
*E*
*E*
*D*
*D*               IF INTERRUPTING THE EXECUTION OF A SPECIAL SHARED
*D*               PROCESSOR WHOSE DATA OR DCBS EXTEND OVER TEL'S
*D*               PROCEDURE THE USER IS ABORTED (A5-06).
*D*
ECCP2    EQU      %
         TITLE    'DCB CHECKER'
         LB,6     UB:ASP,4          IS A SPECIAL SHARED PROC RUNNING
         BEZ      T:ECA             NO
         LI,14    X'A506'           ERR CODE FOR INCOMPATABLE SP.SHRD.
         SCS,14   -8
         LB,7     PB:PVA,6          ASP PROCEDURE PAGE
         LB,6     PB:PVA,5          ACP PROCEDURE PAGE
         CW,6     7                 ABORT USER IF COMMAND PROCESSOR
         BL       ECCP1              PROC IS BELOW ASP PROCEDURE
*D*
*D*               OTHERWISE IT IS OK TO ASSOCIATE THE COMMAND PROCESSOR
*D*
T:ECA    EQU      %
         BUMP     19,2
         BAL,2    DPROCS
         LD,6     SYSACT
         LW,3     TSTACK              FIX ENVIRONMENT FOR ASP:
         LCI      2
         STM,6    13-15,3             R13/14 = ACCOUNT (:SYS)
         LI,2     0
         STW,2    9-15,3              R9 = 0 (LM ONLY, NOT CF)
*D*
*D*               IF THERE IS NO C.P. ASSOCIATED WITH THE USER (UB:ACP
*D*               = 0) LOG-ON IS ASSOCIATED TO DELETE THE USER.
*D*               IF THE USER IS ON-LINE THE BTD BIT IN M:UC IS
*D*               RESET. IF HE IS BEING ABORTED BECAUSE OF AN
*D*               OPERATOR KEY-IN OR A LINE HANG-UP LOGON IS
*D*               ASSOCIATED TO DELETE THE USER.
*D*               J:RNST IS SET TO ZERO AND CONTROL PASSES TO T:ASP
*D*               WITH TEXTC 'LOGON' IN R6/R7.
*D*
*D*               OTHERWISE CONTROL PASSES TO ASP1 WITH THE
*D*               COMMAND PROCESSOR # IN R5.
*D*
         LB,5     UB:ACP,4          GET COMMAND PROCESSOR #
         BEZ      EC10              NONE-GO TO LOGOFF
         LCF      J:JIT             IS THE USER ON-LINE
         BCR,8    ASP1              NO-GO TO COMMAND PROCESSOR
         LI,3     X'F0'
         STS,2    M:UC              CLEAR BTD FOR TEL
         LB,3     J:RNST
         CI,3     X'18'             OP ABORT/LINE HANGUP
         BAZ      ASP1
EC10     STB,2    J:RNST
         LD,6     LOGON
         B        T:ASP
         TITLE    'INTERPRETIVE EXIT LOGIC'
*F*
*F*      NAME:    STEP00
*F*
*F*      PURPOSE: INTERPRETIVE EXIT LOGIC
*F*
*F*      DESCRIPTION: STEP00 PROCESSES THE REQUEST OF A COMMAND
*F*               PROCESSOR BY INTERPRETING ITS REGISTERS AT
*F*               THE TIME OF THE EXIT.
*F*
*F*               R6 OF THE EXIT ENVIRONMENT IS CHECKED FOR A
*F*               REQUEST.  IF ZERO THE REQUEST IF FOR LOGOFF OR
*F*               CONTINUE AND CONTROL TRANSFERS TO THE STEP10 ROUTINE.
*F*
*F*               OTHERWISE THE REQUEST IS FOR A PROCESSOR OR USER
*F*               PROGRAM.  THE COMMAND PROCESSOR THAT ISSUED THE INTERPRETIVE
*F*               EXIT IS RUN DOWN AND CONTROL TRANSFERS TO THE ASSOCIATE
*F*               PROGRAM LOGIC AT T:ASP
*F*
*D*      NAME:    STEP00
*D*
*D*      CALL:    ENTERED FOLLOWING AN EXIT FROM A COMMAND PROCESSOR.
*D*
*D*      DESCRIPTION:  SPECIAL-JIT-ACCESS AND TEL-IN-CONTROL ARE
*D*               RESET IN UH:FLG. THE COMMAND PROCESSOR'S USE COUNT
*D*               IS DECREMENTED. THE C.P.'S PROCEDURE PAGES ARE
*D*               REMOVED FROM THE USER'S CMAP AND THE ACCESS CODE
*D*               FOR THE PAGES RESET BY THE STEP002 SUBROUTINE.
*D*                                 REGS=(R4=S:CUN,R15=UH:FLG)
STEP00   EQU      %
         RSETSST  SJAC              RESET 'SPECIAL-JIT-ACCESS'
         BAL,2    DRTEL1            RESET 'TEL-IN-CONTROL'; DECR PB:UC
         LB,5     UB:ACP,4
         BAL,0    STEP002           CLEAR OUT C.P. PROCEDURE.
         LW,0     J:PPRIV           RESTORE USER PRIVILEGES FROM
         STW,0    J:UPRIV           J:PPRIV WHERE SAVED EARLIER.
         LI,R0    0                 CLEAR THE PROCESSOR
         STW,R0   J:PPRIV            PRIVILEGES
*D*
*D*               R6 OF THE EXIT ENVIRONMENT IS CHECKED FOR A REQUEST.
*D*               IF ZERO, IT'S LOGOFF OR CONTINUE, SO GO TO STEP10.
*D*
         LW,6     TSTACK
         LW,6     6-15,6            (REG.6 FROM STACK)
         BEZ      STEP10
*D*               OTHERWISE, WE ARE DRIVING FOR A PROCESSOR OR
*D*               USER PROGRAM.
*D*
*D*               THE REST OF THE COMMAND PROCESSOR-FILE MANAGEMENT
*D*               BUFFERS, DATA, DCB, AND DYNAMIC DATA PAGES- IS
*D*               REMOVED FROM THE USER.
*D*
*D*               FILE MANAGEMENT BUFFERS ARE RELEASED BY CALLING
*D*               THE MM ROUTINE T:ZBUF.  PAGES FOR SHARED PROCESSOR
*D*               DATA AND DCBS ARE RELEASED BY CALLING THE MM ROUTINE
*D*               T:RVPI.  THE NUMBER OF PAGES TO BE RELEASED IS THE
*D*               SUM OF PB:DSZ + PB:DCBSZ.  THE 1ST PAGE TO BE RELEASED
*D*               IS COMPUTED AS FOLLOWS:
*D*
*D*                PB:PVA(1ST PROCEDURE PAGE) - PB:DCBSZ - PB:DSZ
*D*
         LW,7     J:RNST
         AND,7    Y003E
         BNEZ     STEP04            USER/PROCESSOR RUNNING
         PUSH     5                  (SAVE USER C.P. NUMBER)
         BAL,0    CLSDCBS           CLOSE ALL OPEN DCBS
RELBUF   BAL,6    T:ZBUF            RELEASE FPOOLS
         PULL     4                 PROCESSOR NUMBER
         LB,7     PB:PVA,4          INITIALIZE R7 TO FIRST PROC. PAGE
         LB,6     PB:DCBSZ,4        # PAGES OF DCBS
         LB,9     PB:DSZ,4          # PAGES OF DATA
         AW,6     9                 TOTAL # PAGES TO RELEASE
         BEZ      RELCOM            NONE
         SW,7     6                 FIRST PAGE TO RELEASE
         BAL,11   T:RVPI
         NOP
         AI,7     1
         BDR,6    %-3
RELCOM   EQU      %
         LI,7     0
         STW,7    J:UPRIV           NO PRIVILEGES ANY MORE.
         STW,7    J:TREE
         STW,7    J:DCBLINK
*D*
*D*               DYNAMIC DATA PAGES ARE THEN RELEASED BY CALLING
*D*               T:RVPI FOR EACH PAGE IN THE USER'S CMAP THAT IS NOT
*D*               SET WITH THE FPMC, BEGINNING WITH J:BUP AND ENDING W
*D*               WITH JB:BCP(BOTTOM COMMON PAGE).
*D*
         LH,8     JB:BCP            GET JB:BCP
         AND,8    MASKS+8           AND RELEASE
         LW,7     J:BUP             ALL PAGES
NEXT     LOAD,6   JX:CMAP,7         BETWEEN
         CI,6     FPMC              BEGINNING OF USER
         BE       %+2               PROGRAM (J:BUP)
         BAL,11   T:RVPI            AND BOTTOM OF
         AI,7     1                 COMMON PAGES
         CW,7     8                 (JB:BCP)
         BL       NEXT
*D*
*D*               T:RSTLMS IS CALLED TO RESET ALL MEMORY LIMITS TO
*D*               THEIR INITIAL VALUES, AS IN THE USER RE-INITIALIZATION
*D*               LOGIC.  AT THIS POINT THE USER IS RE-INITIALIZED EXCEPT
*D*               FOR COMMON PAGES.
*D*
         BAL,4    T:RSTLMS
*D*
*D*               THE NAME OF THE C.P. THAT PERFORMED THE INTERPRETIVE
*D*               EXIT IS STORED IN R4/R5 OF THE EXIT ENVIRONMENT
*D*
STEP04   EQU      %
         LW,5     TSTACK
         LW,4     S:CUN
         LB,6     UB:ACP,4
         LD,6     P:NAME,6
         LCI      2
         STM,6    -11,5             R4 & R5 OF STACK
*                                   CONTAIN TEXTC C.P. NAME
         LCI      3
         LM,6     -9,5              NAME OR CCI RUN TABLE ADDR.
         STW,6    0,5               SAVE RUN TABLE ADDR FOR FETCH
*
*  IF AN ONLINE USER THAT IS BEING ASSOCIATED WITH LOGON, RESET
*  THE HALF-DUPLEX PAPER TAPE MODE.
*
         CD,R6    LOGON             C/ACP BEING CALLED W/'LOGON'
         BNE      STEP04C           BNE
         BAL,R5   COCGLN            GET LINE # IN R2, CHECK
         B        STEP04C           RETURN POINT IF NOT ONLINE OR # BAD
         DISABLE                    **DISABLE**
         LB,R15   MODE3,R2          L/MODE3
         AND,R15  NB31TO0+7         &/MODE3 W/.FFFFFFBF; RESET .40
         STB,R15  MODE3,R2          S/MODE3
         LW,R15   J:ACCN            L/1ST WD OF ACCOUNT #
         BEZ      STEP04B           BEZ; LOGGING ON, NOT OFF
         LH,R15   UH:FLG2,R4        L/UH:FLG2
         OR,R15   BT31TO0+6         SET COC-HANGUP/LOGOFF-IN-PROGRESS
         STH,R15  UH:FLG2,R4        S/UH:FLG2
STEP04B  ;
         ENABLE                     **ENABLE**
*D*
*D*               IF LOG0N PERFORMED THE EXIT TO INITIALIZE AN ON-LINE
*D*               USER, UB:ACP MUST BE SET TO TEL.
*D*
STEP04C  LB,13    UB:ACP,4          GET COMMAND PROCESSOR #
         LD,10    LOGON             TEXTC 'LOGON'
         BAL,1    CHKDRSP           IS LOGON EXITING
         B        %+2               YES-SWITCH TO TEL
         B        STEP06            NO
         LB,1     UB:ACP,4          RESTORE LOGON #
         MTB,-1   PB:REP,1          DECREMENT LOGON
         LI,1     PNAMEND            AND SWITCH TO TEL
         LD,2     TEL
         CD,2     P:NAME,1
         BE       STEP09
         BDR,1    %-2
*D*
*D*               R6 WILL CONTAIN THE TEXTC NAME OF THE LOAD MODULE
*D*               REQUESTED IF TEL PREFORMED THE EXIT AND CONTROL WILL
*D*               TRANSFER TO THE ASSOCIATE PROGRAM LOGIC, T:ASP.
*D*
*D*               IF CCI PERFORMED THE EXIT R6 WILL CONTAIN THE
*D*               ADDRESS OF THE RUN TABLE IN COMMON STORAGE.  WORDS 3-5
*D*               OF THE RUN TABLE, CONTAINING THE REQUESTED LOAD MODULEE
*D*               NAME, ARE OBTAINED AND STORED IN R6-8 OF THE EXIT
*D*               ENVIRONMENT.  SIMILARY, THE ACCOUNT AND PASSWORD
*D*               ARE MOVED TO THE APPROPRIATE ENVIRONMENT REGISTERS.
*D*               AFTER THUS SIMULATING A TEL EXIT FOR CCI, R6-8 ARE
*D*               RELOADED WITH THE TEXTC REQUEST NAME AND CONTROL
*D*               PASSES TO THE ASSOCIATE PROGRAM LOGIC, T:ASP.
*D*
STEP06   EQU      %
         CW,6     YFF               TEXTC NAME IN R6 MEANS
         BANZ     T:ASP              TEL PERFORMED THE EXIT
         LW,5     TSTACK
         LCI      3                 SIMULATE A TEL EXIT FOR CCI
         LM,1     3,6               GET INFO FROM RUN TABLE
         STM,1    -9,5              INTO TSTACK REGISTERS
         LCI      2
         LM,1 6,6
         STM,1 -2,5
         LM,1     8,6
         STM,1    -5,5
         LCI      3
         LM,6     -9,5
         B        T:ASP
*
STEP09   EQU      %
         STB,1    UB:ACP,4
         MTB,1    PB:REP,1
         LW,R5    TSTACK
         STW,2    -11,5
         STW,3    -10,5
         BAL,R5   COCGLN            GET COC LINE NUMBER IN R2, CHECK
         B        STEP06
         PAGE
         TITLE    'T:ASP  -   ASSOCIATE SHARED PROGRAM'
*F*      NAME:    T:ASP
*F*
*F*      PURPOSE: ASSOCIATE PROGRAM LOGIC
*F*
*F*      DESCRIPTION: T:ASP FIRST VERIFIES THAT THE USER IS ALLOWED
*F*               TO ACCESS THE PROGRAM HE IS REQUESTING.
*F*
*F*               IF THE USER HAS NOT REQUESTED A SHARED PROCESSOR
*F*               CONTROL IS TRANSFERED TO FETCH TO READ THE LOAD
*F*               MODULE INTO CORE.
*F*
*F*               OTHERWISE, PAGES FOR SHARED PROCESSOR DCBS AND DATA
*F*               ARE OBTAINED; THE JIT IS SET UP TO REFLECT THE MEMORY
*F*               DELIMITERS FOR THE SHARED PROCESSOR; DCB AND DATA
*F*               PAGES ARE INITIALIZED; THE APPROPRIATE UB:ACP/APR/ASP/DB
*F*               IS SET WITH THE SHARED PROCESSOR NUMBER. CONTROL
*F*               THEN TRANSFERS TO THE GO TO USER LOGIC AT ASP14.
*F*
*D*
*D*      NAME:    T:ASP
*D*
*D*      CALL:    ENTERED FROM THE 'LNKTRC' MODULE ON M:LINK OR ON
*D*               M:LDTRC WHERE REQUESTED PROGRAM IS NOT A TRANSFER FILEE.
*D*
*D*               ENTERED FROM T:ECA TO ASSOCIATE LOGON
*D*
*D*               ENTERED FROM XIT10 TO ASSOCIATE DELTA WITH A USER PROGGRAM.
*D*
*D*               ENTERED FROM STEP00 ON AN INTERPRETIVE EXIT.
*D*
*D*               ENTERED FROM FETCH TO ASSOCIATE RUNNER.
*D*
*D*      INPUT:   R6-R8 = TEXTC NAME OF REQUESTED PROGRAM.
*D*
*D*      OUTPUT:  R2/R3 = SHELL PSD (MAPPED,SLAVE)
*D*               R4 = USER NUMBER
*D*               R8 = P:SA FOR PROCESSOR ASSOCIATED
*D*               R9 = ADDRESS OF PROCESSORS 1ST PROCEDURE PAGE
*D*               R10 = P:TCB FOR PROCESSOR ASSOCIATED.
*D*
*D*      DESCRIPTION:
*D*               THE P:NAME TABLE IS SEARCHED FOR A MATCH WITH THE
*D*               REQUESTED PROGRAM NAME IN R6-R8 AND WHEN FOUND THE
*D*               PROCESSOR NUMBER IS PRESERVED IN R5.  IF THE ACCOUNT
*D*               SPECIFIED IS :SYS, ASP1 IS ENTERED WITH THE SHARED
*D*               PROCESSOR NUMBER IN R5.  OTHERWISE ASP1 IS ENTERED
*D*               WITH R5 SET TO ZERO TO INDICATE AN UNSHARED PROGRAM.
*D*
T:ASP    EQU      %
         LI,5     PNAMEND
         CD,6     P:NAME,5
         BE       ASP0
         BDR,5    %-2
         B        ASP1
ASP0     LW,2     TSTACK
         LCI      2
         LM,12    -2,2              GET ACCOUNT
         CD,12    SYSACT            IS IT :SYS
         BE       ASP1              YES-GETTING SHARED PROCESSOR
         LI,5     0                 NO-SET TO GO TO FETCH
*        B        ASP1
         PAGE
*D*
*D*      NAME:    ASP1
*D*
*D*      CALL:    ENTERED FROM ASSOCIATE PROGRAM LOGIC, T:ASP
*D*
*D*               ENTERED FROM T:ECA TO ASSOCIATE THE USER'S
*D*               COMMAND PROCESSOR.
*D*
*D*      INPUT:   R5 = # OF SHARED PROCESSOR TO BE ASSOCIATED.
*D*
*D*               R5 = 0 IF PROGRAM TO BE ASSOCIATED IS NOT SHARED.
*D*
*D*      DESCRIPTION: THE STEP IN PROGRESS FLAG IS SET IN UH:FLG TO
*D*               SPEED THE I/O PROGRESS DURING USER RE-INITIALIZATION.
*D*
ASP1     LW,4     S:CUN
         LRSETS   INIT,10
         OR,10    X4000
         STH,10   UH:FLG,4
*D*
*D*               IF THE USER HAS NO FILE MANAGEMENT BUFFERS THE
*D*               NUMBER OF BUFFERS TO BE ALLOCATED IS COMPUTED AND THE
*D*               UPPER LIMIT OF THE SPARE BUFFERS THAT MAY BE ALLOCATED
*D*               FOR FILE MANAGEMENT IS SET IN JB:FBUL.  THIS IS SO MM
*D*               GET PAGE ROUTINES WILL HOLD BACK FOR UNALLOCATED BUFFERS
*D*               WHEN ALLOCATING PAGES FOR DATA, PROCEDURE AND DCBS.
*D*
*D*               THE NUMBER OF BUFFERS HELD BACK IS DETERMINED BY THE JIT
*D*               VALUE 'JBNFPOOL' WHICH IS SET TO A DEFAULT VALUE OR AS
*D*               SPECIFIED ON THE !POOL CARD.  A USER THAT DOES NOT HAVE
*D*               SYMBIONT ACCESS MAY SPECIFY A MAXIMUM OF 20.  IF A USER
*D*               HAS SYMBIONT ACCESS, THE NUMBER SPECIFIED MUST NOT
*D*               EXCEED THE LESSOR OF 20 MINUS THE NUMBER OF BUFFERS IN THE
*D*               SPARE BUFFER AREA CURRENTLY IN USE BY THE SYMBIONTS, OR
*D*               18, AS AT LEAST 2 BUFFERS WILL ALWAYS BE HELD BACK
*D*               FOR USE BY THE SYMBIONTS.
*D*
*D*               IF THE USER'S FILE MANAGEMENT BUFFER REQUEST EXCEEDS THIS
*D*               LIMITATION, HE WILL BE GIVEN THE MAXIMUM POSSIBLE
*D*               BASED ON THE NUMBER OF SPARE BUFFERS CURRENTLY BEING
*D*               USED BY THE SYMBIONTS.  A USER IS ALWAYS GIVEN A MINIMUM
*D*               OF 4 FILE MANAGEMENTS EVEN IF LESS WAS SPECIFIED ON
*D*               THE !POOL CARD.
*D*
         MTB,0    JB:FBUL           DOES USER HAVE ANY FPOOLS
         BNEZ     ASP3              YES
         LI,6     JBNFPOOL          GET NUMBER REQUESTED
         LB,6     J:JIT,6
         LI,7     JOVVP-1           MAX FPOOL UL
         LI,8     X'FFFF'           IS USER ALLOWED
         AND,8    JH:LDCF                SYMBIONT ACCESS
         BEZ      ASP25             N0-FILE MANAGEMENT CAN HAVE ALL
         LI,7     JBCBLL
         LB,7     J:JIT,7           CPOOL CURRENT LL
         CI,7     JOVVP-2           ALLOW FOR AT LEAST TWO CPOOLS
         BLE      %+2
         LI,7     JOVVP-2
         AI,7     -1                MAX FPOOL UL
ASP25    AI,6     JXBUFVP-1         VP OF REQUESTED FPOOL UL
         CI,6     JXBUFVP+3         IS REQUEST BELOW MINIMUM
         BGE      %+2               NO
         LI,6     JXBUFVP+3         GIVE HIM THE MINIMUM
         CW,6     7                 ARE THERE ENOUGH SPARE BUFFERS LEFT
         BLE      ASP27             YES
         LW,6     7                 NO-GIVE HIM WHAT WE CAN
ASP27    STB,6    JB:FBUL           SET FPOOL UL AS REQUESTED
*D*
*D*               IF 'RUNNER' IS BEING ASSOCIATED TO PROCESS DEBUG
*D*               COMMANDS, ASP SECURITY CHECKS MAY BE BY PASSED.
*D*
ASP3     LW,10    Y003E             GET RNST FOR CHECKS TO
         AND,10   J:RNST             SEE IF AT JOB STEP TIME
         CI,5     0                 IS THIS A SHARED PROCESSOR
         BE       ASPNCP            NO
         LD,6     P:NAME,5          IF GOING FOR RUNNER WE CAN SKIP
         CD,6     NRUNNER            THESE CHECKS AND MUST NOT
         BE       ASP245              RESET THE M:XX DCB
*D*
*D*               THE PROCESSOR FLAGS IN P:SA ARE CHECKED TO SEE IF THE
*D*               REQUEST IS FOR A COMMAND PROCESSOR. IF SO, THE USER
*D*               MUST BE PROPER FOR THE REQUESTED C.P.; BATCH
*D*               IF REQUESTING A BATCH C.P., ON-LINE IF FOR AN ON-LINE
*D*               C.P., ETC.  IF THE USER DOES NOT MATCH THE REQUESTED
*D*               C.P. HE IS ABORTED WITH ERROR CODE A2-00.
*D*
*E*      ERROR:   A2-00
*E*      MESSAGE: ATTEMPT TO ACCESS UNAUTHORIZED PROCESSOR
*E*
         LW,1     P:SA,5            GET ACCESS FLAGS FOR PROC
         CW,1     Y07
         BAZ      ASPNCP            ITS NOT A COMMAND PROCESSOR
         LI,8     1
         LC       J:JIT             COMPARE USER MODE WITH ACCESS
         BCR,12   BATCH             MODES PERMITTED FOR REQUESTED
         BCS,4    GHOST             COMMAND PROCESSOR.
         AI,8     2
BATCH    AI,8     1
GHOST    CB,8     1                 IS ACCESS ALLOWED
         BAZ      TELLA2            NO
*D*
*D*               IF ASSOCIATING A C.P. AND IT IS NOT JOB-STEP TIME
*D*               ASP SECURITY CHECKS MAY BE BY-PASSED.
*D*
         LH,2     UH:FLG2,4
         AND,2    XBFFF             RESET CP BREAK BIT
         STH,2    UH:FLG2,4
         LW,10    10                IS IT JOB STEP TIME
         BEZ      ASP235            YES-CP NAME TO M:XX
         B        ASP24              ELSE LEAVE M:XX AS IT IS
*                                     AND GO ASSOCIATE COMMAND PROCESSORR
*D*
*D*               IF THE PROGRAM TO BE ASSOCIATED IS NOT A C.P. AND IT IS
*D*               NOT JOB-STEP TIME, THE USER MUST BE CALLING FOR DELTA.
*D*
ASPNCP   LW,10    10                IS IT JOB STEP TIME
         BEZ      ASP235            YES
CHKDB    BUMP     -19,2
*D*
*D*               IF CALLING DELTA WHEN AN EXECUTE ONLY LOAD MODULE IS
*D*               IN EXECUTION THE USER IS ABORTED WITH ERROR CODE A1-01.
*D*
*E*
*E*      ERROR:   A1-01
*E*      MESSAGE: DONT TRY TO DEBUG AN EXECUTE ONLY LOAD MODULE
*E*
         LW,1     J:EXLY            IS USER CALLING DELTA
         CW,1     EXLYMSK            TO DEBUG EXECUTE ONLY LMN
         BANZ     TELLA101          YES-ABORT HIM
*D*
*D*               IF CALLING DELTA WHEN A SHARED PROCESSOR IS IN
*D*               EXECUTION THE USER IS ABORTED WITH ERROR CODE A1-00.
*D*
*E*
*E*      ERROR:   A1-00
*E*      MESSAGE: DONT TRY TO DEBUG A SHARED PROCESSOR
*E*
         LB,1     UB:APR,4          IS STD SHRD PROCESSOR RUNNING
         BNEZ     TELLA1            YES-DONT ASSOC DEBUGGER
         LB,1     UB:ASP,4          IS SPC. SHRD. PROC. ASSOCIATED
         BEZ      ASP22             NO-ASSOC IT IF IT IS A DEBUGGER
         LW,1     P:SA,1            YES-GET FLAGS FOR SPC. SHRD. PROC.
         LC       1
         BCR,1    TELLA1            CURRENT SP. SHRD. PROC. NOT A CORE LIBRARY
*D*
*D*               IF THE PROCESSOR HE IS CALLING IS NOT DELTA THE USER
*D*               IS ABORTED WITH ERROR CODE A0-00.
*D*
*E*
*E*      ERROR:   A0-00
*E*      MESSAGE: THAT'S NO DEBUGGER
*E*
ASP22    LW,1     P:SA,5            GET FLAGS FOR NEW SHARED PROCESSOR
         LC       1
         BCR,2    TELLA0            NOT A DEBUGGER
*D*
*D*               IF DELTA'S DATA PAGE OVERLAPS AN ASSOCIATED CORE
*D*               LIBRARY'S PROCEDURE THE USER IS ABORTED WITH
*D*               ERROR CODE A1-02.
*D*
*E*      ERROR:   A1-02
*E*      MESSAGE: LIBRARY CONFLICTS WITH DEBUGGER
*E*
         LB,1     UB:ASP,4          GET LIBRARY #
         BEZ      CHKDB1            NONE ASSOCIATED
         LI,14    2
         LB,2     PB:PVA,1          LIBRARY PROCEDURE
         CB,2     PB:PVA,5            : DELTA'S PROCEDURE
         BL       TELLA101+1
*D*
*D*               IF UNABLE TO OBTAIN A PAGE FOR DELTA'S DATA PAGE
*D*               THE USER IS ABORTED WITH ERROR CODE A5-02.
*D*
*E*
*E*      ERROR:   A5-02
*E*      MESSAGE: VIRTUAL CORE NOT AVAILABLE FOR SPECIAL SHARED PROCESSOR
*E*
CHKDB1   LW,7     J:EUP             SEE IF THERE IS ROOM FOR A DEBUGGER
         AI,10    NOROOMSS          SET PROPER SUBCODE
         CI,7     JEUPVP
         BNE      OUTOFPGS+1        NO ROOM
         AI,7     1                 YES-MAKE SURE WE CAN GET THE PAGE
         BAL,11   T:RVPI
         NOP
         B        ASP24             DONT RESET M:XX
         PAGE
*DO*
*D*
*
*   CHECK FOR :SYS ONLY AND/OR RESTRICTED PROCESSOR LIST
*      XOS   (BIT 6 OF J:ASSIGN) RESTRICTS USER TO :SYS PROCESSORS
*      RP    (BIT 7 OF J:ASSIGN) INDICATES THE PRESENCE OF
*        A RESTRICTED PROCESSOR LIST FOR THIS USER IN THE
*        :PROCS FILE. THIS FILE IS KEYED IN THE SAME MANNER AS :USERS
*
*        THE FIRST WORD OF THE RECORD CONTAINS THE NUMBER OF
*        ENTRIES IN THE RECORD FOR THIS USER, AND IN THE HIGH ORDER BIT
*        INDICATES THE MODE OF THE LIST - 1 - LIST OF ILLEGAL PROCESSORS
*                                       - 0 - LIST OF LEGAL PROCESSORS
*
*        FORMAT OF EACH ENTRY IN :PROCS (RP)) FILE
*
*        |----------------|-----------------------|---------|
*        |    FLAG BYTE   |  TEXTC PROCESSOR NAME | ACCOUNT |
*        |0 1 2 3 4 5 6 7 |     2->12 BYTES       | 8 BYTES |
*        |----------------|-----------------------|---------|
*         | | | | | | | |
*         | | | | | > > >   RESERVED FLAG BITS
*         | | | | |
*         | | | | >   INDICATES PARTIAL PROCESSOR NAME
*         | | | |
*         | | | >   ACCOUNT FIELD PRESENT (IF ZERO, :SYS USED)
*         | | |
*         | | >   THIS PROCESSORS CONTROLLED FOR GHOST USER
*         | |
*         | >   THIS PROCESSOR CONTROLLED FOR ONLINE USER
*         |
*         >   THIS PROCESSOR CONTROLLED FOR BATCH USER
*
*
*FIN*
XOS      EQU      2                 BIT 6 IN J:ASSIGN
RP       EQU      1                 BIT 7 OF J:ASSIGN
ASP235   BAL,11   CLOSEXX
         LB,R1    JB:PRIV           GET USERS PRIV
         CI,R1    X'C0'             IS HE ABOVE ALL THIS SECURITY
         BG       NOCHECK           IS HE ABOVE ALL THIS SECURITY
         LW,R8    P:SA,R5           PICK UP CP FLAGS
         CW,R8    Y07               IS IT A COMMAND PROC ?
         BANZ     NOCHECK           B/ YES, LET HIM THRU
         LB,R1    J:ASSIGN          GET XOS,RP FLAGS
         CI,R1    XOS+RP            IS USER RESTRICTED
         BAZ      NOCHECK           B/ NO, SKIP ALL CHECKS
         CI,R1    XOS               IS HE RESTRICTED TO :SYS
         BAZ      RPLIST            B/ NO, CHECK :PROCS FILE RP LIST
         LW,R2    TSTACK
         LCI      2
         LM,R12   -2,2              PICK UP ACCOUNT OF PROCESSER REQ
         CD,R12   SYSACT            IS IT :SYS
         BNE      XOSABORT          B/ NO, ABORT HIM
*E*
*E*      ERROR:   A2-01
*E*      MESSAGE: ACCESS TO NON-SYSTEM PROCESSOR DENIED BY INSTALLATION
*E*
         CI,R1    RP                :SYS IS OK, ALSO RP CHECK ?
         BAZ      NOCHECK           B/ NO, HE'S OK TO GO
RPLIST   EQU      %
         PUSH     2,R4              SAVE USER #, PROC #
         LD,R6    RPFILE            SET UP TO OPEN RPL FILE
         LD,R12   SYSACT            ACCOUNT
         LCI      2
         STM,R6   M:XX+23           NAME TO M:XX
         STM,R12  M:XX+27           ACCOUNT TO M:XX
         LI,R3    X'FF00'
         LI,R2    X'200'            2 WORDS FOR ACCN
         STS,R2   M:XX+22
         STS,R2   M:XX+26           2 WORDS FOR NAME
         LI,R2    0                 NO PASSWORD
RPOPEN   EQU      %
         LI,R2    RPERR1            ERR/ABN ADDRESS FOR READS
         LB,R6    JB:PRIV           GET USERS PROV
         PUSH     R6                SAVE IT FOR LATER
         LI,R6    X'C0'             TEMP BYPASS FILE SECURITY
         STB,R6   JB:PRIV
         BAL,0    OPNXX
         PULL     R6                GET BACK USERS PRIV
         STB,R6   JB:PRIV           PUT IT BACK
         LH,R1    M:XX
         CI,R1    X'20'             IS FILE OPEN
         BAZ      RPERR2            B/NO
*
*   SET UP TO READ RP FILE RECORD
*
KEYBUF   EQU      M:XX+32           KEYBUF FIELD IN M:XX
         LI,R2    J:JIT+JACCN       ACCOUNT
         LI,R4    0
         LI,R8    8                 MAX SIZE OF ACCOUNT
         BAL,R11  CONCAT
         LI,R6    X'40'             BLANK BETWEEN NAME,ACCOUNT
         AI,R4    1
         STB,R6   KEYBUF,R4         PUT IT INTO KEY
         LI,R2    J:JIT+JUNAME      NAME
         LI,R8    12                MAX SIZE OF NAME
         BAL,R11  CONCAT
         STB,R4   KEYBUF            PUT IN TEXTC BYTE COUNT
*
*   GET SPECIAL BUFFER AND READ RECORD
*
RPBUF    EQU      SBUF1VPA          SPECIAL BUFFER 1
         LI,R14   RPBUF
         BAL,R2   T:GBUF
         LI,R0    KEYBUF            ADDRESS OF KEY
         LW,R7    Y4                BIT TO BYPASS
         STS,R7   J:ASSIGN          BUFFER CHECKING
         LI,R7    RPBUF             ADDRESS FOR READ BUFFER
         LI,R6    512*4             MAX SIZE OF RECORD IN BYTES
         BAL,R11  READ              GO READ RECORD
         BAL,11   CLOSEXX+3
*
*   SEARCH RECORD FOR REQUESTED PROCESSOR
*
         LH,R0    RPBUF             PICK UP COUNT AND FLAG
         AND,R0   MASKS+15          GET RID OF COUNT AND FLAG
         LI,R1    RPBUF+RPBUF+RPBUF+RPBUF+4  BYTE ADDRESS OF FIRST ENTRY
         LW,R2    TSTACK
         LCI      3
         LM,R9    -11,R2            PROCESSOR NAME
         LM,R12   -4,R2             ACCOUNT (ONLY TWO WORDS)
*   BEGIN SEARCH LOOP
RPLOOP   EQU      %
         LB,R8    0,R1              PICK UP FLAG BYTE
         AI,R1    1
         LB,R7    0,R1              PICK UP TEXTC BYTE COUNT
         AI,R1    1
         LW,R15   R1                ADDRESS FOR CBS
         AW,R1    R7                BUMP R1 PAST NAME
         LI,R14   R9*4+1            SOURCE ADDRESS FOR CBS, SKIP COUNT
         CI,R8    8                 IS THIS A PARTIAL NAME
         BANZ     RPPN              B/PARTIAL NAME , USE COUNT IN FILE
         LB,R7    R9                FULL NAME, USE REQ'D COUNT
RPPN     EQU      %
         STB,R7   R15               COUNT FOR CBS
         CBS,R14  0                 COMPARE IT
         BNE      RPNXT             B/ NOT THIS ENTRY, TRY NEXT
         CI,R8    X'10'             IS ACOUNT FIELD PRESENT
         BANZ     RPACCN            B/ YES, CHECK ACCOUNT FIELD
         CD,R12   SYSACT            NO, COMPARE WITH :SYS
         BNE      RPNXT             B/ NOT A MATCH
         B        RPFND             MATCH FOUND
RPACCN   EQU      %
         LI,R14   R12*4             BA OF PROCESSOR ACCOUNT
         LW,R15   R1                BA OF ENTRY'S ACCOUNT FIELD
         LI,R7    8                 ALWAYS SIZE OF 8
         STB,R7   R15               COUNT FOR CBS
         CBS,R14  0
         BE       RPFND             B/ FOUND MATCH
RPNXT    EQU      %
         CI,R8    X'10'             IS ACCOUNT FIELD PRESENT
         BAZ      RPNXT1            B/NO
         AI,R1    8                 BUMP UP PAST ACCOUNT FIELD
RPNXT1   AI,R0    -1                DECR COUNTER
         BGZ      RPLOOP            B/ BO CHECK NEXT
*
*   REQUESTED PROCESSOR IS NOT IN LIST, COULD BE GOOD OR BAD
*
         LC       RPBUF             GET MODE FLAG BIT
         BCS,8    RPOK              B/ OK TO LOAD
RPABORT  EQU      %
         LI,R14   RPBUF             ADDRESS OF BUFFER TO RELEASE
         LI,R10   2                 SUBCODE OF TWO FOR RPABORT
         LI,R1    X'A2'             MAJOR ERROR CODE
         B        ABN1A             GO ABORT USER RELEASING BUFFER
*E*
*E*      ERROR:   A2-02
*E*      MESSAGE: ACCESS TO PROCESSOR DENIED BY INSTALLATION
*E*
RPFND    EQU      %
         LC       J:JIT             GET USER MODE
         BCS,4    RPGHST            GHOST USER
         BCS,8    RPONLN            ONLINE USER
         SLS,R8   -1
RPONLN   SLS,R8   -1                LINE UP BITS
RPGHST   SLS,R8   -5
         SLS,R8   31                PUT BIT INTO B0 POSITION, CLEARING
         LW,R1    RPBUF             GET MODE BITS
         AND,R1   Y8                CLEAR OUT ANYTHING ELSE
         EOR,R1   R8                COMPARE, MODE BIT MUST NOT MATCH
         BEZ      RPABORT           B/ THEY MATCH, ABORT HIM
RPOK     EQU      %
         LI,R5    0
         LI,R14   RPBUF             ADDRESS OF BUFFER
         BAL,R2   T:RBUF
         PULL     2,R4              GET USER #, PROC #
*D*
*D*               THE NAME, ACCOUNT AND PASSWORD OF THE PROGRAM TO BE
*D*               ASSOCIATED IS MOVED TO THE M:XX DCB TO BE USED BY
*D*               THE RUNNING MONITOR FOR EXECUTE-ONLY CHECKS.
*D*
NOCHECK  EQU      %                 COME HERE TO SKIP ALL RP AND XOS CHECKS
         LW,2     Y003E
         AND,2    J:RNST            IS IT JOB STEP TIME
         BNEZ     ASP24             NO-DONT RESET M:XX
         LW,2     TSTACK
         LCI      2
         LM,12    -2,2              ACCOUNT
         LM,14    -5,2              PASSWORD
         STM,12   M:XX+27           ACCOUNT TO M:XX
         STM,14   M:XX+30           PASSWORD TO M:XX
         LCI      3
         LM,6     -9,2              NAME
         CI,5     0                 IS IT  A SHARED PROCESSOR
         BE       %+2               NO
         LD,6     P:NAME,5          YES-GET NAME
         LCI      3
         STM,6    M:XX+23           NAME TO M:XX
         LI,1     X'300'            WORDS USED FOR NAME
         STS,1    M:XX+22
         LI,1     X'200'            WORDS USED FOR ACCT/PASSWORD
         STS,1    M:XX+26
         STS,1    M:XX+29
*D*
*D*      THE CAL3 TRANSFER VECTOR, J:ALB IS INITIALIZED AND THE
*D*      TARGET PSD IN J:XPSD+2-3 IS PRESET TO ZERO
*D*
         LI,1     CAL3PSD
         STW,1    J:ALB             CAL3'S ABORT THRU ROOT
         LI,1     0
         STW,1    J:XPSD+2
         STW,1    J:XPSD+3
*D*
*D*               IF THE PROGRAM TO BE ASSOCIATED IS NOT A SHARED
*D*               PROCESSOR CONTROL PASSES TO FETCH.
*D*
ASP24    CI,5     MAXOVLY
         BLE      FETCH             NOT IN P:NAME TABLE
         LB,8     PB:PSZ,5
         BEZ      FETCH             IT'S SIZE IS 0
         LW,7     Y2
         STS,7    MXFPL+1           SET THE FETCH SIGNATURE
*
*                 BYPASS-MESSING-WITH-M:XX LOGIC FOR RUNNER COMES HERE
ASP245   EQU      %
         LC       J:CFLGS
         BCR,X'C' %+3               EXTRA ENVIRON NO LONGER NEEDED
*                                   FOR LDLNK TO PROCESSOR
         BUMP     -19,8
         LW,8     P:SA,5
*D*
*D*               CHECKS MUST BE MADE TO DETERMINE IF IT IS VALID TO
*D*               ASSOCIATE THE REQUESTED SHARED PROCESSOR.
*D*
ASP271   EQU      %
         LW,2     Y002              FOR EXTENDED USER CHECKS
         LI,12    JEUPVP            FOR LIMIT CHECKS
*D*
*D*               IF THE USER IS ATTEMPTING TO M:LINK OR M:LDTRC TO A
*D*               SPECIAL SHARED PROCESSOR HE IS ABORTED WITH ERR CODE B5-6C.
*D*
         LCF      8                 IS THIS A SPECIAL SHARED PROCESSOR
         BCR,4    ASP272              NO
         LI,10    LDLKSS
         LC       J:CFLGS           TRYING TO LINK/LDTRC TO SPEC. PROC
         BCS,4    ABN11             YES-ABORT USER
*E*
*E*      ERROR:   B5-6C
*E*      MESSAGE: LOAD AND LINK TO SPECIAL SHARED PROCESSOR NOT ALLOWED
*E*
*D*
*D*               IF A USER RUNNING IN THE EXTENDED MEMORY MODE IS
*D*               ATTEMPTING TO ASSOCIATE A SP. SHARED PROCESSOR
*D*               HE IS ABORTED WITH ERROR CODE A5-02.
*D*
*E*
*E*      ERROR:   A5-02
*E*      MESSAGE: VIRTUAL CORE NOT AVAILABLE FOR SPECIAL SHARED PROCESSOR
*E*
         LI,10    NOROOMSS
         CW,12    J:EUP               YES-IF SPECIAL PROCESSOR AREA HAS
         BNE      OUTOFPGS+1              BEEN RELEASED, ABORT
         LC       J:JIT
         BCR,8    ASP36
         CW,2     J:TELFLGS             EXTENDED CORE
         BANZ     OUTOFPGS+1                ABORT HIM
         B        ASP36             ALL OK-DONT RESET MEM LIMS FOR SPEC. SHRD.
*
*D*
*D*               IF A USER RUNNING IN THE EXTENDED MEMORY MODE IS
*D*               ATTEMPTING TO ASSOCIATE A STANDARD SHARED PROCESSOR
*D*               THAT WAS LOADED WITH THE 'CORELIB' OPTION HE IS
*D*               ABORTED WITH ERROR CODE A5-02.
*D*
*E*      ERROR:   A5-02
*E*      MESSAGE: VIRTUAL CORE NOT AVAILABLE FOR SPECIAL SHARED PROCESSOR
*E*
ASP272   EQU      %
         LI,10    NOROOMSS
         CW,8     Y008              CORELIB OPTION ON STD SHRD PROC
         BAZ      ASP273            NO
         CW,12    J:EUP             YES-IF SPECIAL PROCESSOR AREA HAS
         BNE      OUTOFPGS+1            BEEN RELEASED, ABORT
         LC       J:JIT
         BCR,8    ASP273
         CW,2     J:TELFLGS         IF AN ON-LINE USER WANTS
         BANZ     OUTOFPGS+1         EXTENDED CORE-ABORT HIM
*D*
*D*               IF A STANDARD SHARED PROC. PROCEDURE WOULD OVERLAP THE
*D*               COMMON PAGES CURRENTLY ALLOCATED TO THE USER HE IS
*D*               ABORTED WITH ERROR CODE A5-07.
*D*
ASP273   LI,10    PROVCOMM
         LB,6     PB:HVA,5          NEXT PAGE FOLLOWING PROCEDURE
         AI,6     -1                LAST PROCEDURE PAGE
         LI,7     1
         CB,6     JB:BCP,7            :  BOTTOM COMMON PAGE
         BG       OUTOFPGS+1        PROCEDURE OVERLAPS WITH COMMON
*E*
*E*      ERROR:   A5-07
*E*      MESSAGE: PROGRAM OVERLAPS CURRENTLY ALLOCATED COMMON PAGES
*E*
*D*
*D*               IF THE PROCESSOR TO BE ASSOCIATED IS A SPECIAL SHARED
*D*               PROCESSOR,THE USERS MEMORY DELIMITERS AND THE ACCESSS
*D*               CODES FOR THE USER PAGES (BUP-EUP) ARE NOT CHANGED.
*D*               THE ACCESS ON THE DATA,DCB,AND PROCEDURE PAGES WILL
*D*               LATER (IN THE ASP14 LOGIC) BE SET VIA THE T:PAC ROUTINE
*D*               IN THE 'MM' MODULE.
*D*
*D*               OTHERWISE, THE PROCESSOR TO BE ASSOCIATED IS A STANDARD
*D*               SHARED PROCESSOR, AND THE FOLLOWING MEMORY DELIMITERS
*D*               ARE ESTABLISHED IN J:JIT.
*D*                 J:DUL = J:DLL+PB:DSZ-1
*D*                 J:DCBLL = J:DUL+1
*D*                 J:DCBUL = J:DUL+PB:DCBSZ
*D*                 J:PLL = PB:PVA
*D*                 J:PUL = PB:HVA-1
*D*                 J:DDLL = PB:HVA
*D*
         LB,7     PB:HVA,5          NEXT PAGE AFTER PROCEDURE
         STW,7    J:DDLL
         STW,7    J:PUL
         MTW,-1   J:PUL
         LB,7     PB:PVA,5          FIRST PAGE OF PROCEDURE
         STW,7    J:PLL
         STW,7    J:DCBUL
         MTW,-1   J:DCBUL
         LB,6     PB:DCBSZ,5        # PAGES OF DCBS
         SW,7     6                 FIRST PAGE OF DCBS
         STW,7    J:DCBLL
         STW,7    J:DUL
         MTW,-1   J:DUL
         LB,6     PB:DSZ,5          DATA SIZE
         SW,7     6                 FIRST PAGE OF DATA
         STW,7    J:DLL
*D*
*D*               THE ACCESS CODES FOR THE DATA,DCB AND PROCEDURE
*D*               PAGES ARE SET VIA T:SNAC IN MM AS FOLLOWS:
*D*                 J:DLL->J:DUL = 00
*D*                 J:DCBLL->J:DCBUL = 10
*D*                 J:PLL->J:PUL = 01
*D*
         LB,6     PB:DSZ,5          DATA SIZE
         BEZ      ASP29
         LI,4     0                 AC FOR DATA
         BAL,11   T:SNAC
ASP29    LB,6     PB:DCBSZ,5        DCB SIZE
         BEZ      ASP30
*D*
*D*               IF A COMMAND PROCESSOR IS BEING ASSOCIATED THE ISTEL1
*D*               ROUTINE IN SCHED IS CALLED TO SET TIC IN UH:FLG AND
*D*               BUMP PB:UC FOR THE C.P.
*D*
         LW,7     J:DCBLL
         LI,4     2                 AC FOR DCBS
         BAL,11   T:SNAC
ASP30    EQU      %
         LB,6     PB:HVA,5          NEXT PAGE AFTER PROCEDURE
         LB,7     PB:PVA,5          PROCEDURE ADDRESS
         SW,6     7
         LI,4     1                 AC FOR PURE P
         BAL,11   T:SNAC
*D*
*D*               IF NO M:LDTRC ACTION IS TAKING PLACE THE TOP DYNAMIC
*D*               PAGE (JB:TDP) IS SET TO PB:HVA.  IF M:LDTRC WERE
*D*               TAKING PLACE, JB:TDP IS SET BY THE LNKTRC MODULE TO
*D*               REFLECT THE DYNAMIC PAGES OWNED BY THE PROCESSOR
*D*               BEING RESTORED.
*D*
         LC       J:CFLGS
         BCS,8    ASP36             DONT RESET UPPER CORE IF RESTORING
*                                   PROCESSOR FOR LDTRC
         LB,7     PB:HVA,5          NEXT PAGE AFTER PROC. = TDP
         STB,7    JB:TDP
*D:
*D*               THE SPECIAL SHARED PROCESSOR AREA IS THEN APPENDED TO
*D*               THE USER AREA UNLESS ANY OF THE FOLLOWING CONDITIONS
*D*               EXIST:
*D*                 A)  THE USER CALLED THE PROCESSOR VIA M:LINK.
*D*                 B)  THE PROCESSOR WAS LOADED WITH THE CORELIB OPTION.
*D*                 C)  AN ON-LINE USER IS RUNNING AND HAS NOT REQUESTTED
*D*                     THE EXTENDED MEMORY MODE.
*D*                 D)  THE USER CURRENTLY HAS COMMON PAGES ALLOCATED.
*D*
         LC       J:CFLGS           DONT RESET EUP/BCP IF LINKING
         BCS,4    ASP36              TO A SHARED PROCESSOR
         CW,8     Y008              CHECK STD SHARED PROCESSOR
*                                     FOR CORELIB OPTION
         BANZ     ASP36             SET-DONT RESET UPPER CORE
         LC       J:JIT             ON-LINE USER
         BCR,8    %+4               NO
         LW,1     Y002
         CW,1     J:TELFLGS         DOES USER WANT EXTENDED CORE
         BAZ      ASP36             NO
         LI,6     1
         LB,4     JB:BCP,6          BOTTOM COMMON PAGES
         CW,4     J:EUP             ANY COMMON PAGES ALLOCATED
         BNE      ASP36             YES-DONT CHANGE CORE
         LI,1     X'FF'             GIVE USER ALL OF CORE
         STW,1    J:DDUL
         STW,1    J:EUP
         LI,7     1
         STB,1    JB:BCP,7
ASP36    EQU      %
*D*
*D*               J:RNST IS SET AS FOLLOWS:
*D*                 IF ASSOCIATING DELTA THE USER IS SET RUNNING.
*D*                 IF ASSOCIATING A C.P. J:RNST IS NOT CHANGED.
*D*                 IN ALL OTHER CASES PROCESSOR RUNNING IS SET.
*D*               J:UPRIV IS SET TO REFLECT THE PRIVILEGES OF THE
*D*                 NEW PROCESSOR (UNLESS IT'S DELTA OR A LIBRARY).
*D*                 OLD J:UPRIV IS SAVED IN R9 IN CASE:
*D*                 1.  GOING TO C.P., PSAVE IT IN J:PPRIV.
*D*                 2.  CANT ASSOC NEW PROC, RESTORE IT.
*D*
         LW,9     J:UPRIV            (SAVE J:UPRIV IN R9)
         LW,6     USER
         LCF      8
         BCS,3    %+2               IF CORE OR DEBUG SET USER RUNNING
         LW,6     PROC
         CW,8     Y07               DRIVING FOR COMM PROC
         BANZ     ASP5              YES, SKIP SETTING RNST
         LW,7     Y003E
         STS,6    J:RNST
ASP5     EQU      %
         LCF      8                 ASSOCIATING DELTA OR A LIBRARY
         BCS,3    ASP51             YES-DONT SET PROCESSOR ACCT.
         LW,6     PR:PA             SET PROCESSOR ACCOUNTING
         CW,8     Y08               MAX MEMORY
         BAZ      %+2               NO
         OR,6     PR:MM
         LCF      8                 SJAC
         BCR,8    %+2               NO
         OR,6     PR:SJ
         CW,8     Y004              M:SYS PERMISSION
         BAZ      %+2               NO
         OR,6     PR:MS
         STW,6    J:UPRIV
ASP51    LW,4     S:CUN
         LH,10    UH:FLG,4          ACCUMULATE FLAGS IN R10
*D*
*D*               INIT (IF PB:DSZ NOT = 0), DCB (IF PB:DCBSZ NOT =  0),
*D*               AND PPSWP ARE SET IN UH:FLG.
*D*
*D*               PAGES FOR SHARED PROCESSOR INITIAL DATA AND DCBS ARE
*D*               OBTAINED VIA THE MM ROUTINE 'T:GNVNPI' (GET N VIRTUAL/
*D*               NO PHYSICAL).  T:GNVNPI PLACES THE NO PAGE MAP
*D*               CONSTANT (NPMC) INTO THE USERS CMAP INDICATING TO THE
*D*               SWAPPER TO PLACE INITIAL DATA AND DCBS THERE DURING
*D*               SWAP IN.
*D*
*D*               THE NUMBER OF PAGES TO BE ACQUIRED VIA T:GNVNPI IS
*D*               COMPUTED AS FOLLOWS:
*D*                 PB:PVA-PB:DCBSZ-PB:DSZ  (1ST PROC. PAGE - DCB SIZE
*D*                                                    -DATA SIZE)
*D*
*D*               WHEN OBTAINING PAGES FOR A STANDARD SHARED PROCESSOR
*D*               THE APPROPRIATE PAGE COUNT IN THE JIT, JB:PCD IF DATA,
*D*               JB:PCDCB IF DCB, WILL BE INCREMENTED BY T:GNVNPI.
*D*               HOWEVER, WHEN OBTAINING PAGES FOR A SPECIAL SHARED PROOCESSOR,
*D*               BECAUSE THE USER MEMORY LIMITS HAVE NOT BEEN CHANGED,
*D*               SPECIAL SHARED PROCESSOR DATA AND DCB PAGES ARE INCLUDED
*D*               IN THE COUNT OF CONTEXT PAGES, JB:PCC.
*D*
*D*
*D*               IF THE PAGES CANNOT BE OBTAINED THE USER IS ABORTED
*D*               WITH ERROR CODE A5-00.
*D*
         LC       J:CFLGS           DONT RESTORE PAGES IF RESTORING
         BCS,8    ASP8               PROCESSOR FOR LDTRC
         LB,7     PB:PVA,5          INITIALIZE R7 TO FIRST PROC. PAGE
         LB,6     PB:DCBSZ,5        # OF PAGES OF DCBS
         BEZ      ASP6              NONE
         SETR     DCBS,10
         SW,7     6                 FIRST PAGE TO GET
ASP6     LB,11    PB:DSZ,5          # OF PAGES OF DATA
         BEZ      ASP7              NONE
         SETR     INIT,10
         SW,7     11                TO GET DATA PAGE FROM SP.PROC AREA
ASP7     AW,6     11                DCB SIZE + DATA SIZE
         BEZ      ASP8              NONE
         SETR     PPSWP,10
         BAL,11   T:GNVNPI          GET DATA AND DCB PAGES
         BCR,15   ASP8              ALL IS O.K.
*D*               UNLESS GOING FOR DELTA'S DATA PAGE AND ONLY
*D*               THE USER'S CORE LIMIT PREVENTS GETTING IT.
         LI,1     JB:MNPA
         MTB,1    0,1
         BAL,11   T:GNVNPI          TRY ONE MORE TIME
         STCF     11
         LI,1     JB:MNPA
         MTB,-1   0,1
         BDR,11   ASP8              GOT IT THIS TIME
         LW,10    Y003E             DONT REALLY ABORT THE USER
         AND,10   J:RNST
         B        OUTOFPGS+1
*E*
*E*      ERROR:   A5-00
*E*      MESSAGE: LOAD MODULE SIZE EXCEEDS USER LIMIT OR AVAILABLE CORE
*E*
*D*
*D*               THE CHKSIZE ROUTINE IS CALLED TO INSURE THAT THERE
*D*               IS ENOUGH PHYSICAL CORE TO INCLUDE THE SHARED PROCESSOOR
*D*               PROCEDURE PAGES.  CHKSIZE WILL SET UP UB:ACP/APR/ASP/DB
*D*               AS SPECIFIED AND CALL THE T:TOTESZ ROUTINE IN MM.
*D*               CHKSIZE WILL ABORT THE USER WITH ERROR CODE A5-08 IF
*D*               THERE IS INSUFFICIENT PHYSICAL CORE FOR THE SHARED PROCESSOR.
*D*
ASP8     EQU      %
         LW,4     S:CUN
         CW,8     Y07               IS IT A COMMAND PROC
         BAZ      ASP9              B IF NO
         LI,1     UB:ACP
         BAL,0    T:CHKSIZ          INSURE ENOUGH PCORE
         STW,9    J:PPRIV            UPRIV ->PPRIV WHILE IN C.P.
         LW,15    10                GOING FOR TEL OR CCI
         BAL,2    ISTEL1
         LW,10    15
         B        ASP12
ASP9     LCF      8                 GOING FOR OTHER PROCESSOR
         BCR,4    ASP10             NOT TEL OVERLAY
         BCR,2    ASP18             NOT DEBUGGER
         LI,1     UB:DB
         BAL,0    T:CHKSIZ
*D*
*D*               IF DELTA IS BEING ASSOCIATED DIC AND DELA ARE SET
*D*               IN UH:FLG.
*D*
         SETR     DIC,10
         SETRST   DELA,10
         B        ASP11
ASP18    EQU      %                 CORE LIBRARY OR SPEC. SHARED. PROC.
         LI,1     UB:ASP
         BAL,0    T:CHKSIZ          INSURE ENOUGH PCORE
         B        ASP11
*D*
*D*
*D*               LINK IS OBTAINED FROM PB:LINK UNLESS THE PROCESSOR IS
*D*               BEING RE-ASSOCIATED FOLLOWING AN M:LDTRC.  IN THIS
*D*               CASE BYTE 1 OF J:CFLAGS CONTAINS THE OVERLAY LINK.
*D*
ASP10    LI,1     UB:APR
         BAL,0    T:CHKSIZ
         LB,6     PB:LNK,5
         LC       J:CFLGS
         BCR,8    ASP105
         LI,6     1
         LB,6     J:CFLGS,6         IF RESTORING PROC FOR LDTRC
*                                   GET CORRECT APO
ASP105   EQU      %
         STB,6    UB:APO,4
*D*
*D*               UNLESS THE PROCESSOR IS A C.P. THE IPROCS ROUTINE IN
*D*               SCHED IS CALLED TO BUMP PB:UC FOR ALL ASSOCIATED PROCESSORS.
*D*
ASP11    BAL,2    IPROCS            COUNT 'EM UP
*D*
*D*               THEN, IN ALL CASES, THE RTR FLAG IS RESET IN UH:FLG AND
*D*               AN ASSOCIATE PROCESSOR EVENT IS REPORTED ON THE USER
*D*               AS A REQUEST TO THE SWAPPER TO ASSOCIATE ALL SHARED
*D*               PROCESSORS ASSOCIATED WITH THE USER.
*D*
ASP12    EQU      %
         RSETSST  RTR,10
         LI,6     E:AP
         BAL,11   T:REG             GET 'EM
*D*
*D*               AFTER RETURN FROM THE REG THE REGISTERS FOR THE
*D*               GO TO USER LOGIC AT ASP14 ARE SET UP.
*D*
         LB,9     PB:PVA,5
         SLS,9    9
         LW,10    P:TCB,5
         LW,8     P:SA,5
         LCF      8                 IS THIS A SPECIAL SHARED PROCESSOR
         BCS,4    %+2               YES-DONT RESET TREE
         STW,9    J:TREE            1ST PROCEDURE PAGE HAS TREE
         LW,4     S:CUN
*D*
*D*               THE DCBS ARE LINKED TO THE JIT IN J:DCBLINK IF ITS
*D*               PREVIOUS VALUE WAS ZERO AND THE PROCESSOR HAS
*D*               DCBS (PB:DCBSZ NOT = ZERO).
*D*
         LW,2     J:DCBLINK         LINK DCB'S IF NOT ALLREADY LINKED
         BNEZ     ASP131            AND IF ANY.
         LB,3     PB:DCBSZ,5
         BEZ      ASP131
         LB,2     PB:PVA,5          FIRST PROCEDURE PAGE
         SW,2     3                  -DCB SIZE = FIRST DCB PAGE
         SLS,2    9                 CONVERT TO WORD ADDRESS
         STW,2    J:DCBLINK
*D*
*D*               CONTROL IS THEN TRANSFERED TO THE GO TO USER
*D*               LOGIC, ASP14.
*D*
ASP131   EQU      %
         LD,2     SMPSD
         B        ASP14+1           TO SET START ADDR AND ASSIGN/MERGE
         TITLE    'FETCH-READ UNSHARED LOAD MODULE'
*F*
*F*      NAME     FETCH
*F*
*F*      PURPOSE: ASSOCIATE UNSHARED PROGRAM LOGIC
*F*
*F*      DESCRIPTION: FETCH FIRST DETERMINES IF ANY DEBUG COMMANDS
*F*               WERE ENCOUNTERED AND IF SO RUNNER IS REQUESTED
*F*               TO READ THE HEAD RECORD FOR THE LOAD MODULE TO
*F*               BE ASSOCIATED AND PROCESS THE DEBUG COMMANDS.
*F*
*F*               OTHERWISE THE HEAD AND TREE RECORD ARE READ INTO
*F*               STEP'S DATA PAGE USING THE M:XX DCB.
*F*
*F*               FETCH CHECKS THE VALIDITY OF THE LOAD MODULE AND THE
*F*               VALIDITY OF ASSOCIATING THE LOAD MODULE AT THIS PARTICULAR
*F*               JOB STEP.  THE LOAD MODULE IS THEN READ INTO THE
*F*               USER AREA.  ANY DEBUG OR MODIFY TABLES BUILT BY
*F*               RUNNER ARE MERGED INTO THE USER PROGRAM AND CONTROL
*F*               TRANSFERS TO THE ASSEMBLE UNSHARED PROGRAM LOGIC
*F*               AT XIT10.
*F*
HBUF     EQU      SBUF1VPA          BUFFER ADDRESS FOR HEAD
TBUF     EQU      HBUF+15           BUFFER ADDRESS FOR TREE
LMKEY    EQU      TBUF+1            KEY ADDRESS FOR READING LMN
LDRKEY   EQU      TBUF+12           FOR FIRST WORD FROM HEAD RECORD
RNRKEY   EQU      TBUF+13           TO INDICATE WE WENT TO RUNNER
*D*
*D*      NAME:    FETCH
*D*
*D*      CALL:    ENTERED FROM THE ASSOCIATE PROGRAM LOGIC, T:ASP
*D*               WHEN THE REQUEST IS FOR AN UNSHARED PROGRAM.
*D
*D*      DATA:    CCI RUN TABLE
*D*               STEP'S DATA PAGE
*D*
*D*      DESCRIPTION:  THE M:XX DCB, WHICH WILL BE USED TO READ THE
*D*               LOAD MODULE IS INITIALIZED.
*D*
FETCH    EQU      %
         LI,2     ERRTN             ERR/ABN
*D*
*D*               THE M:XX DCB IS OPENED AND IF THE LOAD MODULE IS AN
*D*               EXECUTE-ONLY LOAD MODULE THE J:EXLY BIT IS SET
*D*               IN THE USER'S JIT.
*D*
         BAL,0    OPNXX
         LW,1     M:XX
         CW,1     Y002              DID THE FILE GET OPENED
         BAZ      OPNERR            NO
         CI,1     X'100'            IS THIS AN EXECUTE ONLY FILE
         BAZ      FCH4              NO
         LB,1     JB:PRIV           * IS USER C0 PRIV?
         CI,1     X'C0'             * IF SO, SKIP SECURITY
         BGE      FCH4              * CHECKS FOR ME
         LW,1     EXLYMSK           YES-SET FLAG IN JIT
         STS,1    J:EXLY
         B        FCH4GO            SKIP !XEQ LOGIC TEST
*D*
*D*               AT FCH4 THE M:XX FILE IS EXAMINED TO SEE IF IT'S
*D*               REALLY A LOAD MODULE (KEYED, KEYM ~ = 3).  IF
*D*               IT'S NOT A LOAD MODULE, AND IF BIT 30 OF
*D*               S:OPTION = 0, AN !XEQ COMMAND OF THE PROPER
*D*               FORMAT IS GENERATED IN J:CCBUF, M:XX IS
*D*               CLOSED, BITS INDICATING 'COMMAND IN BUFFER' AND
*D*               'AT JOB STEP' ARE SET IN J:RNST OR J:TELFLGS,
*D*               AND XIT50 IS CALLED TO RUN DOWN WHATEVER WAS LEFT
*D*               OF THE USER'S CORE IMAGE (STEP'S DATA PAGE, AND
*D*               MAYBE SOME COMMON CORE IF THE COMMAND FILE WAS INVOKED
*D*               VIA AN M:LDTRC).  XIT50 PASSES CONTROL TO T:ECA WHICH
*D*               FETCHES THE USER'S COMMAND PROCESSOR (TEL OR CCI);  THE
*D*               CP THEN PARSES AND EXECUTES THE !XEQ COMMAND.
*D*
FCH4     LI,1     2                 CHECK BIT 30 IN S:OPTION
         CW,1     S:OPTION          ..IF SET THEN THIS INSTALLATION
         BANZ     FCH4GO            ....DOESN'T WANT SPECIAL !XEQ
         LB,1     J:JIT             GET FIRST BYTE OF JIT
         CI,1     X'08'             ARE WE CURRENTLY !XEQ'ING?
         BANZ     FCH4GO            IF SO SKIP !XEQ LOGIC - WON'T WORK.
         MTW,0    J:STAR+5          HAVE WE M:LINK'ED?
         BNEZ     FCH4GO            IF SO !XEQ LOGIC IS ILLEGAL
         LI,6     X'30'             GET MASK FOR M:XX ORG
         AND,6    M:XX+5            GET M:XX ORG
         CI,6     X'20'             IS M:XX KEYED?
         BNE      FCH4X1            IF NOT LET'S TRY !XEQING IT
         LB,6     M:XX+12           GET KEYM FOR A KEYED FILE
         CI,6     3                 IS KEYM = 3?
         BNE      FCH4GO            IF NOT IT'S PROBABLY A LOAD MODULE
FCH4X1   LC       J:JIT             GET USER TYPE FROM JIT
         BCS,4    FCH4GO            IF GHOST, THIS DOESN'T APPLY
         BCS,8    XEQONLN           IF ONLINE GET ONLINE FORMAT STUFF
         LI,1     BATCHFAKE         GET PTR TO BATCH CODES
         B        XEQMOVE
XEQONLN  LI,1     ONLNFAKE          GET PTR TO ONLINE CODES
XEQMOVE  LCI      5                 5 WORDS OF FAKE-UP STUFF
         LM,1     *1                GET THE STUFF INTO SOME REGS.
         LI,7     BA(J:CCBUF)       GET BA OF COMMAND BUFFER
         LB,6     *1                GET BC OF COMMAND HEADER
         STB,6    7                 SAVE BC IN R7
         LW,6     1                 GET WA(HEADER)
         SLS,6    2                 MAKE IT A BYTE ADDRESS
         AI,6     1                 SKIP BC
         MBS,6    0                 MOVE COMMAND HEADER
         LB,6     MXFPL+1           GET BC OF FILE NAME
         STB,6    7                 SAVE BC IN R7
         LI,6     BA(MXFPL+1)+1     GET BA(FILENAME)
         MBS,6    0                 MOVE FILENAME TO CMD BUFFER
         STB,2    0,7               STORE '.' (ONLN) OR ',' (BTCH)
         AI,7     1                 BUMP POINTER
         LI,6     8                 8 BYTES IN ACCOUNT #
         STB,6    7                 SAVE BC
         LI,6     BA(MXFPL+5)       GET BA(ACCOUNT #)
         MBS,6    0
         BAL,8    DEBLANKR
         LW,6     MXFPL+8           GET FIRST WORD OF PASSWORD
         OR,6     MXFPL+9           ANY PASSWORD PRESENT?
         BEZ      XEQFINI           IF NOT CLOSE UP COMMAND
         STB,2    0,7               STORE '.' OR ','
         AI,7     1                 BUMP PTR AGAIN
         LI,6     8                 8 BYTES FOR PASSWORD
         STB,6    7
         LI,6     BA(MXFPL+8)       GET BA(PASSWORD)
         MBS,6    0
         BAL,8    DEBLANKR          STRIP TRAILING BLANKS
XEQFINI  LI,6     2                 2 BYTES IN WRAPUP DATA
         STB,6    7                 SAVE BC
         LI,6     3**2+2            WRAPUP IN LOW HW OF R3
         MBS,6    0                 MOVE WRAPUP DATA TO CMD BUFFER
         AI,7     -BA(J:CCBUF)      CALCULATE BUFFER SIZE
         STB,7    JB:CCARS          SAVE BUFFER LENGTH
         STS,5    *4                STORE FLAG BITS
         LW,1     J:CFLGS
         AND,1    NB31TO0+31        MASK OFF 'JOB STEP IN PROGRESS'
         STW,1    J:CFLGS
         LI,1     X'20000'
         STS,1    J:ASSIGN          SPECIAL M:XX CLOSE BIT
         BAL,11   CLOSEXX           CLOSE M:XX
         LD,4     0PSD              REMOVE ANY LEFT-OVER ENVIRONMENTS
         STD,4    TSTACK              FROM THE USER'S TSTACK
         B        XIT50             RUN DOWN USER & GET TEL OR CCI
*
*
DEBLANKR LI,6     ' '               LOOK FOR BLANKS
         AI,7     -1                START ON A GOOD CHARACTER
         CB,6     0,7               IS THIS A BLANK?
         BNE      %+2               IF NOT RETURN HERE
         BDR,7    %-2               LOOP BACK FOR NEXT BYTE
         AI,7     1                 MOVE PAST THE NONBLANK
         B        *8                RETURN TO CALLER
*D*
*D*
*D*                  AT FCH4GO, SPECIAL BUFFER 1 (SBUF1VPA) IS OBTAINED VIA
*D*                  THE T:GBUF ROUTINE IN MM TO BE USED FOR STEP'S
*D*                  DATA PAGE.
*D*
*D*
FCH4GO   LI,14    SBUF1VPA
         BAL,2    T:GBUF
*D*
*D*               IF THE FILE IS NOT A KEYED FILE THE USER IS
*D*               ABORTED (A6-39)
*D*
         LI,1     NOTKEYED
         LI,7     X'30'
         AND,7    M:XX+5
         CI,7     X'20'
         BNE      FETCH3
*E*
*E*      ERROR:   A6-39
*E*      MESSAGE: FILE NOT KEYED, NOT A LOAD MODULE
*E*
*D*
*D*               THE HEAD RECORD IS READ INTO STEP'S DATA PAGE VIA
*D*               THE 'READ' SUBROUTINE, FIRST SETTING Y4 IN
*D*               J:ASSIGN (BYPASS BUFFER CHECK)
*D*
         LI,7     SBUF1VPA          BUFFER ADDRESS
         LI,6     12*4              SIZE OF HEAD RECORD
         LW,0     TSTACK
         AI,0     1                 KEY ADDRESS
         LW,4     TSTACK
         BUMP     2,1
         LCI      2
         LM,1     HEAD
         STM,1    1,4
         LW,1     Y4
         STS,1    J:ASSIGN
         BAL,11   READ
         BUMP     -2,1
         LW,4     S:CUN
*D*
*D*               IF THE LOAD MODULE TO BE PUT INTO EXECUTION IS A
*D*               PRIVILEGED PROCESSOR THE PRIVILEGE PROCESSOR BITS
*D*               ARE SET IN J:UPRIV.
*D*
         LI,1     0
         LW,6     TSTACK
         LCI      2
         LM,2     -2,6
         CD,2     SYSACT            IF NOT :SYS IT CANT BE PRIV. PROCESSSOR
         BNE      FCH400
         LW,1     Y00F
         AND,1    HBUF+1            IS THIS A PRIV. PROCESSOR
         BEZ      FCH400            NO
         LB,3     JB:PRIV           * CHECK FOR C0 PRIVILEGE
         CI,3     X'C0'             * USER...IF SO...NO EXLY
         BGE      %+3               * BIT SETTING ALLOWED
         LW,3     EXLYMSK           YES-SET EXECUTE ONLY BIT
         STS,3    J:EXLY
         SLS,1    -20               SET PRIVILEGE BITS
FCH400   STW,1    J:UPRIV
*D*
*D*               IF THE USER IS ON-LINE OR M:LINK/M:LDTRC ACTION IS
*D*               TAKING PLACE THERE IS NO RUN TABLE AND CONTROL IS GIVEN
*D*               TO FCH3.
*D*
FCH401   LH,15    UH:FLG,4
         CI,15    BAT|TIC
         BAZ      FCH31             NO RUNNER
         LW,R6    TSTACK            CHECK FOR
         LW,R6    0,R6               RUN TABLE ADDRESS IN TSTACK
         CW,R6    YFF
         BANZ     FCH31              TEL EXIT-NO RUN TABLE
         LC       J:CFLGS
         BCS,4    FCH31             NO RUN TABLE IF LDLNK
*D*
*D*               OTHERWISE, THE CCI BUILT RUN TABLE IS CHECKED FOR DEBUG
*D*               COMMANDS.  IF THERE ARE NONE CONTROL IS GIVEN TO FCH3.
*D*
         LW,7     J:EUP
         LI,1     X'20000'
         CW,1     J:ASSIGN          PMD'S
         BANZ     FCH2              YES
         LW,11    XFFFF00           RUNTABLE BYTE 1 = # DEBUG CMDS.
         AND,11   0,6               RUNTABLE BYTE 2 = # MODIFIES.
         OR,11    10,6              RUNTABLE WORD 10 OR
         OR,11    11,6                WORD 11 NONZERO IF START SPEC.
         BEZ      FCH3              ---> NONE OF THE ABOVE.
*D*
*D*               IF DEBUG COMMANDS WERE SPECIFIED WITH AN EXECUTE-ONLY
*D*               LOAD MODULE THE USER IS ABORTED WITH ERROR CODE A6-51.
*D*
FCH2     LW,0     EXLYMSK
         LI,1     X'51'
         CW,0     J:EXLY            IS THIS EXECUTE ONLY LMN
*E*      ERROR:   A6-51
*E*      MESSAGE: SNAP/MODIFY NOT ALLOWED WITH EXECUTE ONLY LOAD MODULE
         BANZ     FETCH3            YES-THAT'S A NO-NO.
*D*
*D*               RUNNER IS ASSOCIATED BY RELEASING THE SPECIAL PROCESSOOR
*D*               DATA PAGE TO INSURE THAT RUNNER CAN GET THAT PAGE,
*D*               LOADING R13-R14 WITH :SYS, LOADING R6-R8 WITH TEXTC
*D*               'RUNNER', PUSHING ALL REGISTERS INTO TSTACK
*D*               AND BRANCHING TO THE ASSOCIATE PROGRAM LOGIC, T:ASP,
*D*               THEREBY SIMULATING AN INTERPRETIVE EXIT.
*D*
         PUSH     6                 RUN TABLE ADDR
         PUSH     3,10              3 WORDS FOR PSD
         AI,7     1
         BAL,11   T:RVPI
         NOP
         LI,14    SBUF1VPA
         BAL,2    T:RBUF
         LW,13    SYSACT
         LW,14    SYSACT+1
         LI,6     0
         LW,7     Y2
         STS,6    MXFPL+1           ERASE THE FETCH SIGNATURE
         LD,6     NRUNNER
         LI,9     0                 BE SURE RUNNER IS LM NOT CF.
         PUSH     16,0              SET UP ENVIRONMENT
         B        T:ASP             GO GET RUNNER
*D*
*D*               UPON RETURN FROM RUNNER, AND BEFORE RE-ENTERING THE
*D*               FETCH LOGIC, THE RUN TABLE PAGE IS RELEASED
*D*               AND THE HEAD RECORD AND RUNNER CLOBBER TABLE IS
*D*               MOVED INTO STEP'S DATA PAGE. RUNRKEY IN STEP'S DATA
*D*               PAGE IS SET NON-ZERO TO INDICATE RUNNER'S CLOBBER
*D*               TABLE HAS BEEN BUILT.
*D*
XITRUNR  RSETSST  SJAC              RESET 'SPECIAL-JIT-ACCESS'
         BAL,2    DASP              DECREMENT RUNNER'S PB:UC
         BAL,2    RASP              DECREMENT RUNNER'S PB:REP
         BUMP     -19,7
         BAL,0    SPCON             MOVE DATA AS FETCH REQUIRES
         STW,0    RNRKEY            SET SO FETCH WILL KNOW
         B        FCH451            LEAP INTO SECURITY CHECKS
*                                   BYPASS SIZE OF HEAD CHECK AS RUNNER
*                                   HAS REUSED M:XX AFTER READING THE HEEAD
*D*
*D*               AT FCH3, WHERE THE BATCH USER DOES NOT HAVE DEBUG
*D*               COMMANDS, THE RUN TABLE IN COMMON PAGES IS RELEASED.
*D*
FCH3     EQU      %
         LI,6     1
         STB,7    JB:BCP,6
         BAL,11   T:RVPI
         NOP
FCH31    LI,7     SBUF1VPA
*D*
*D*               THE DEBUGGER NAME SPECIFIED IN THE INTERPRETIVE EXIT
*D*               BY TEL IN R0-R1 IS SAVED IN WORDS 12-13 OF STEP'S DATA
*D*               PAGE.
*D*
         LW,2     TSTACK            SET TEL'S "UNDER" NAME INTO HEADER
         LCI      2
         LM,10    -15,2
         STM,10   12,7
*D*
*D*               RNRKEY IN STEP'S DATA PAGE IS SET TO ZERO AS A FLAG
*D*               TO INDICATE THAT RUNNER WASN'T ASSOCIATED.
*D*
         LI,14    0                 SET KEY SO WE KNOW RUNNER
         STW,14   RNRKEY               WASNT ASSOCIATED
*D*
*D*               THE HEAD RECORD IS CHECKED FOR ACCURACY.
*D*               IF THE SIZE IS NOT 48 BYTES THE USER IS ABORTED (A6-35).
*D*
         LI,1     SMALLHEAD
         LW,6     M:XX+13
         CI,6     X'30'
         BNE      FETCH3            HEAD NOT CORRECT SIZE
*E*
*E*      ERROR:   A6-35
*E*      MESSAGE: HEAD RECORD IS INCOMPLETE
*E*
FCH451   EQU      %                 CHECK AFTER RUNNER ENTRY
*D*      SET USER RUNNING SO THAT MM WILL DO LIMIT CHECKS
*D*      CORRECTLY.
         LW,0     USER
         LW,1     Y003E
         STS,0    J:RNST
*D*
*D*               IF THE 1ST WORD OF THE HEAD RECORD IS NOT FORMATTED
*D*               CORRECTLY THE USER IS ABORTED (A6-31).
*D*
         LI,1     BADHEAD
         LI,6     LMKEY
         XW,6     HBUF
         CW,6     HEADMASK          FIRST WD REASONABLE
         BANZ     FETCH3            NO
*E*
*E*      ERROR:   A6-31
*E*      MESSAGE: BAD HEAD RECORD
*E*
         STW,6    LDRKEY            SAVE FOR FUTURE USE
         LB,6     6                 SET 85FLAG IF SO
         LW,9     6                 FOR FUTURE TEST
         CI,6     X'85'
         BNE      %+2
         STB,6    HBUF
*D*
*D*               IF THE MODULE BIAS IS NOT ON A PAGE BOUNDRY
*D*               THE USER IS ABORTED (A6-32)
*D*
         LI,1     BADBIAS
         LW,6     2+HBUF            BIAS
         CI,6     X'FF'
         BANZ     FETCH3
*E*
*E*      ERROR:   A6-32
*E*      MESSAGE: LOAD MODULE BIAS NOT ON PAGE BOUNDRY
*E*
*D*
*D*               IF THE PROCEDURE BIAS IS NOT ON A PAGE BOUNDRY THE
*D*               USER IS ABORTED (A6-33).
*D*
         LI,1     BADPP
         OR,6     4+HBUF
         CI,6     X'FF'
         BANZ     FETCH3
*E*
*E*      ERROR:   A6-33
*E*      MESSAGE: PURE PROCEDURE NOT ON PAGE BOUNDRY
*E*
*D*
*D*               IF THE DCB BIAS IS NOT ON A PAGE BOUNDRY THE USER
*D*               IS ABORTED (A6-34).
*D*
         LI,1     BADDCBLOC
         OR,6     6+HBUF            DCBS
         CI,6     X'FF'
         BANZ     FETCH3
*E*
*E*      ERROR:   A6-34
*E*      MESSAGE: DCBS NOT ON PAGE BOUNDRY
*E*
*D*
*D*               FETCH NEXT DETERMINES HOW CORE IS TO BE ALLOCATED
*D*               (EXTENDED MEMORY MODE OR NON-EXTENDED MEMORY MODE),
*D*               AND CHECKS FOR ERROR CONDITIONS RELATED TO CORE ALLOCATION.
*D*
*D*               IF THE LAST PROCEDURE PAGE FOR THE LOAD MODULE WOULD
*D*               OVERLAP THE COMMON PAGES ALLOCATED TO THE USER THE
*D*               USER IS ABORTED (A5-07).
*D*
         LI,7     1
         LB,7     JB:BCP,7
         CW,7     J:EUP             ARE COMMON PAGES CURRENTLY ALLOCATED
         BE       FCH5              NO
         LI,10    PROVCOMM          LMN OVERLAPS COMMON
         LH,6     HBUF+4            PROCEDURE SIZE
         AW,6     HBUF+4              +BIAS
         AI,6     X'FF'             ROUND UP TO FULL PAGE
         SLS,6    -8
         AND,6    MASKS+8           PAGE # OF PROCEDURE UPPER LIMIT
         LI,7     1
         CB,6     JB:BCP,7            : BOTTOM COMMON PAGE
         BG       OUTOFPGS2+1       IF OVERLAP ABORT USER
*E*
*E*      ERROR:   A5-07
*E*      MESSAGE: PROGRAM OVERLAPS CURRENTLY ALLOCATED COMMON PAGES
*E*
*D*
*D*               IF 'START UNDER DELTA' WAS SPECIFIED WITH AN EXECUTE-
*D*               ONLY LOAD MODULE THE USER IS ABORTED (A1-01).
*D*
FCH5     EQU      %
         MTW,0    J:JIT
         BGEZ     FCH51             ONLY ON-LINE CAN START UNDER
         MTW,0    HBUF+12           DEBUGGER NEEDED
         BEZ      FCH51             NO
         LW,1     EXLYMSK           ITS A START UNDER
         CW,1     J:EXLY            IS THIS AN EXECUTE ONLY LMN
         BAZ      FCH6              NO-ALLOW DEBUGGER
*E*      ERROR:   A1-01
*E*      MESSAGE: DONT TRY TO DEBUG AN EXECUTE ONLY LOAD MODULE
         LI,10    X'01'
         LI,1     X'A1'
         B        ABN1+1
FCH51    LI,0     0                 NO DEBUGGER IF BATCH
         STW,0    HBUF+12
         MTW,0    HBUF+9            CORE LIBRARY NEEDED
         BNEZ     FCH6              YES
         CI,9     X'84'             LOAD MODULE BUILT BY LINK
         BE       FCH453            YES
*D*
*D*               IF M:LINK OR M:LDTRC IS IN PROGRESS, CORE ALLOCATION
*D*               IS NOT CHANGED.
*D*
         LC       J:CFLGS           LDTRC IN PROGRESS
         BCS,4    FETCH7            YES-DONT CHANGE CORE ALLOCATION
*D*
*D*               IF AN ON-LINE USER HAS NOT REQUESTED THE EXTENDED
*D*               MEMORY MODE JIT LIMITS ARE NOT CHANGED AS HE HAS
*D*               BEEN RE-INITIALIZED IN THE NON-EXTENDED MODE.
*D*
         LC       J:JIT             ON-LINE USER
         BCR,8    %+4               NO
FCH452   LW,1     Y002
         CW,1     J:TELFLGS         DOES ON-LINE USER WANT EX. CORE
         BAZ      FETCH7            NO
*D*
*D*               IF ANY COMMON PAGES ARE CURRENTLY ALLOCATED THE
*D*               MEMORY MODE IS NOT CHANGED.
*D*
         LI,6     1
         LB,1     JB:BCP,6          BOTTOM COMMON PAGES
         CW,1     J:EUP             ANY COMMON PAGES ALLOCATED
         BNE      FETCH7            YES-DONT CHANGE CORE ALLOCATION
*D*
*D*               OTHERWISE, THE USER IS GIVEN THE EXTENDED MEMORY MODE
*D*               BY SETTING THE LAST VIRTUAL PAGE OF CORE, X'FF' INTO
*D*               J:EUP, J:DDUL, AND JB:BCP.
*D*
         LI,1     X'FF'             LAST POSSIBLE VIRTUAL PAGE
         STW,1    J:EUP               IS NOW END USER PAGE
         STW,1    J:DDUL               AND DYNAMIC DATA LOWER LIMIT
         STB,1    JB:BCP,6               AND BOTTOM COMMON PAGE
         B        FETCH7
*D*
*D*               IF ATTEMPTING TO M:LINK/M:LDTRC TO A LOAD MODULE
*D*               BUILT BY LINK THE USER IS ABORTED (B5-6B).
*D*
FCH453   LI,10    LDLKLINK          M:LINK/M:LDTRC TO LINKED LMN
         LC       J:CFLGS           IS LINK/LDTRC IN PROGRESS
         BCS,4    ABN1              YES
*E*
*E*      ERROR:   B5-6B
*E*      MESSAGE: LOAD AND LINK TO LINKED PROGRAM NOT ALLOWED
*E*
         LC       J:JIT             ON-LINE USER CAN HAVE EXTENDED
         BCS,8    FCH452             CORE WITH LINK BUILD LM IF REQUESTED
         B        FETCH7            BATCH USER RUNNING LINK BUILT LM IS
*D*
*D*               IF A CORE LIBRARY OR DELTA IS TO BE ASSOCIATED WITH
*D*               THE LOAD MODULE THE USER MUST BE EXECUTING IN THE
*D*               THE NON-EXTENDED MEMORY MODE.
*D*
FCH6     EQU      %
         LC       J:JIT             IS THIS AN ON-LINE USER
         BCR,8    FCH61             NO
*D*
*D*               IF AN ONLINE USER WANTS DELTA OR IS TO EXECUTE A LOAD
*D*               MODULE THAT REQUIRES A CORE LIBRARY AND HE HAS SPECIFIED
*D*               THE EXTENDED MEMORY MODE HE IS ABORTED (A5-02).
*D*
         LW,1     Y002
         CW,1     J:TELFLGS         DOES HE WANT EXTENDED CORE
         BANZ     FCH62
*D*
*D*               OR IF ATTEMPTING TO M:LINK/M:LDTRC TO A LOAD MODULE
*D*               THAT REQUIRES A CORE LIBRARY FROM A PROGRAM EXECUTING
*D*               IN THE EXTENDED MEMORY MODE THE USER MUST BE
*D*               ABORTED (B5-02).
*D*
*E*
*E*      ERROR:   B5-02
*E*      MESSAGE: VIRTUAL CORE NOT AVAILABLE FOR SPECIAL SHARED PROCESSOOR
*E*
FCH61    LW,1     J:EUP
         CI,1     JEUPVP            IS CORE ALLOCATED CORRECTLY
         BE       FETCH7            YES
FCH62    LI,10    NOROOMSS          NO-GO TELL USER
         B        OUTOFPGS2+1          MADE A MISTAKE
FETCH7   EQU      %                 END CORE ALLOCATION LOGIC
*D*
*D*               THE TREE RECORD IS THEN READ INTO STEP'S DATA PAGE
*D*
         LI,7     TBUF
         LI,6     12*4
         LW,0     TSTACK
         LW,4     TSTACK
         BUMP     2,1
         LCI      2
         LM,1     TREE
         STM,1    1,4
         AI,0     1
         LW,1     Y4
         STS,1    J:ASSIGN
         BAL,11   READ
         BUMP     -2,1
*D*               IF THE TREE RECORD IS LESS THAN 48 BYTES THE
*D*               USER IS ABORTED (A6-36).
*D*
         LI,1     SMALLTREE
         CW,6     M:XX+13
         BG       FETCH3
*E*
*E*      ERROR:   A6-36
*E*      MESSAGE: TREE RECORD IS INCOMPLETE
*E*
         LI,1     X'50'             VERIFY LOAD MODULE WAS NOT
         INT,7    TBUF+10           BUILT WITH PRE-B00 LOADER
         CI,7     X'4800'           BY CHECKING DCB BIAS
         BE       FETCH3            IF BAD-GEN A6-50
*E*
*E*      ERROR:   A6-50
*E*      MESSAGE: LOAD MODULE IS PRE-B00
*E*
*D*
*D*               NEXT DATA, PROCEDURE, AND DCBS ARE READ INTO
*D*               THE USER AREA VIA THE 'FETCH1' SUBROUTINE.
*D*
         MTB,1    LMKEY
         LW,7     TBUF+6
         LI,10    3
         BAL,9    FETCH1            DATA
         LW,7     TBUF+8
         LH,10    7                 CHECK FOR ZERO
         BNEZ     FETCH452           PROCEDURE SIZE.
         CH,10    TBUF+6            IF DATA SIZE IS
         BNE      FETCH452           ZERO ALSO, INSURE
         LI,10    JBUPVPA             THAT HEAD IS RIGHT
         SLS,10   -1                DOUBLEWORD ADDRESS
         STW,10   HBUF+2            BIAS
         STW,10   HBUF+3            DATA SIZE & START
         AI,10    X'100'
         STW,10   HBUF+4            PROCEDURE SIZE & START
FETCH452 RES      0
         LI,10    5
         BAL,9    FETCH1            PORCEDUR
         LW,7     TBUF+10
         LI,10    7
         BAL,9    FETCH1            DCBS
*D*
*D*               THE M:XX DCB IS THEN CLOSED AND PROCESSING
*D*               CONTINUES AT FCH7.
*D*
         BAL,11   CLOSEXX
         LW,7     Y2
         STS,7    MXFPL+1           SET THE FETCH SIGNATURE
*D*
*D*               FCH7 WILL EXIT IMMEDIATELY TO THE ASSEMBLE UNSHARED
*D*               PROGRAM LOGIC AT XIT10 IF RUNNER WAS NOT ASSOCIATED
*D*               TO PROCESS DEBUG COMMANDS FOR THIS LOAD MODULE.
*D*
FCH7     LW,6     LDRKEY            RESTORE FIRST WORD OF HEAD
         STW,6    HBUF
         LCI      3
         LM,6     M:XX+23           NAME FROM START COMMAND
         STM,6    LMKEY             INTO TREE
         MTW,0    RNRKEY            ANY DEBUGS(WAS RUNNER ASSOCIATED)
         BEZ      XIT10             NO-JOIN UP AFTER XITLINK
*D*               HOWEVER, IF RUNNER HAD BEEN ASSOCIATED,
*D*               THE ADDRESS OF THE CLOBBER TABLE AS BUILT BY
*D*               RUNNER IS STORED INTO WORD 10 FOR EACH SEGMENT
*D*               WITHIN THE TREE.
*D*
         LI,6     SBUF1VPA          WORD ADDRESS OF SPECIAL PAGE
         LW,7     6
         AI,6     X'1FF'            PTS TO WHERE WD 10 OF TREE SAVED
         LW,7     4,7
         SLS,7    1
         LW,1     0,7
         AI,1     -1                SIZE OF TREE
         LI,2     0
FCH8     EQU      %
         LW,5     *6,2
         STW,5    *7,1
         AI,2     -1
         AI,1     -11
         BGZ      FCH8
*  RUN ROOTS CLOBBER TABLE
         LW,1     YFFF              MASK TO DETERMINE WHETHER DB TBL CAL
         LH,6     5                 # OF WDS IN ROOT'S CLOBBER TABLE
         BLEZ     XIT10
         SLS,6    -1
         SLS,5    1
FET9     EQU      %
*  GET ENTRY (VAL&LOC) FROM CLOBBER TABLE
         LW,0     1,5               GET VAL TO STORE
         LW,9     0,5               GET LOC TO STORE AT
         BLZ      FET11
*D*
*D*               THE CLOBBER TABLE VALUES ARE SET INTO THE USER
*D*               PROCEDURE PRESERVING THE REPLACED INSTRUCTION IN
*D*               THE DEBUG FPT IF DEBUG TABLE ENTRY.
*D*
         LW,2     0
         XW,0     *9                GET INST TO REPLACE & SET VAL IN LOC
FET10    EQU      %
         STW,0    5,2               SAVE REPLACED INST
         LW,2     0,2
         AND,2    MASKS+17
         BNEZ     FET10             NO
         B        FET12
FET11    EQU      %
*D*
*D*               THE CLOBBER TABLE VALUE MERELY REPLACES THE PROGRAM
*D*               VALUE ON A MODIFY.
*D*
         STW,0    *9                SET VAL IN LOC
FET12    EQU      %
         AI,5     2
         BDR,6    FET9              ARE THERE ANY MORE ENTRIES IN CLOB
*D*
*D*               PROCESSING THEN CONTINUES AT THE ASSEMBLE UNSHARED
*D*               PROGRAM LOGIC AT XIT10.
*D*
*        B        XIT10
         TITLE    'XIT10-ASSEMBLE UNSHARED PROGRAM LOGIC'
*F*
*F*      NAME:    XIT10
*F*
*F*      PURPOSE: ASSEMBLE UNSHARED PROGRAM LOGIC
*F*
*F*      DESCRIPTION: UPON ENTRY TO XIT10 THE HEAD AND TREE RECORDS
*F*               FOR THE LOAD MODULE ARE IN STEP'S DATA PAGE AND
*F*               THE LOAD MODULE IS CONTAINED IN THE USER AREA WHICH
*F*               CONSISTS OF DYNAMIC DATA ONLY.
*F*
*F*               XIT10 SETS UP THE JIT MEMORY DELIMITERS TO REFLECT THE
*F*               PROGRAM THAT IS TO BE PUT INTO EXECUTION.  THE
*F*               DCB CHECKER IS CALLED TO VALIDATE THE USERS DCBS.
*F*               THE PROGRAM START ADDRESS AND TCB ADDRESS ARE MOVED TO
*F*               THE JIT AND STEP'S DATA PAGE IS RELEASED.
*F*
*F*               A CORE LIBRARY IS ASSOCIATED IF REQUIRED.  IF THE
*F*               PROGRAM IS TO BE EXECUTED UNDER DELTA, CONTOL  IS
*F*               TRANSFERED TO T:ASP TO ASSOCIATE DELTA AND GIVE DELTA
*F*               CONTROL.  OTHERWISE CONTROL TRANSFERS TO THE
*F*               GO TO USER LOGIC AT ASP14.
*F*
*D*      NAME:    XIT10
*D*
*D*      REGISTERS: ALL REGISTERS ARE VULNERABLE
*D*
*D*      CALL:    ENTERED FOLLOWING A FETCH OPERATION.
*D*
*D*               ENTERED TO PROCESS THE GO FUNCTION OF A LOAD AND GO OPERATION.
*D*
*D*      DESCRIPTION:  XIT10 PRODUCES A USER PROGRAM ARRANGED
*D*               CORRECTLY IN MEMORY COMPLETE WITH ANY DEBUGGER OR
*D*               CORE LIBRARY REQUIRED.
*D*
*D*               TSTACK IS FORCED TO A SINGLE ENVIRONMENT,THE USER IS
*D*               IS SET RUNNING IN J:RNST, AND J:ASSIGN IS RE-SET.
XIT10    EQU      %
         LD,0     19PSD             SET SINGLE ENVIRONMENT
         STD,0    TSTACK
         LW,0     USER
         LW,1     J:UPRIV           SEE IF PROCESSOR ACCOUNTING
         CW,1     PR:PA              IS REQUIRED
         BAZ      %+2               NO
         LW,0     PROC
         LW,1     Y003E
         STS,0    J:RNST            SET USER/PROCESSOR RUNNING
         LB,2     J:ASSIGN
         AND,2    X17
         STB,2    J:ASSIGN
*D*
*D*               THE DIFFERENCE BETWEEN THE LOAD MODULE BIAS AND THE START
*D*               IF THE DATA AREA IS CALCULATED.  THIS VALUE IS USUALLY
*D*               ZERO, BUT LOAD AND LINK LEAVE THIS SPACE FOR CORE LIBRARY
*D*               DATA AND BLANK COMMON WHEN REQUIRED.
*D*               IF A DIFFERENCE EXISTS,THOSE PAGES ARE OBTAINED VIA
*D*               THE T:GNVPI (GET N VIRTUAL AND PHYSICAL) ROUTINE IN
*D*               MM.
*D*
         LI,2     SBUF1VPA
         LI,6     X'FF00'
         AND,6    3,2               DATA BIAS
         INT,7    2,2               MODULE BIAS
         SLD,6    -8                CONVERT TO PAGES
         SW,6     7                 # OF PAGES DIFFERENCE
         BEZ      XIT101            NONE
         LI,1     BADBIAS           CHECK TO SEE IF BLANK COMMON
         CI,7     JBUPVP             IS IN USERS VIRTUAL AREA
         BL       FETCH3            NO-GIVE A6-32 ERROR
         BAL,11   T:GNVPI           GET THE PAGES FORTRAN LEFT FOR
*                                     CORE LIBRARY DATA AND BLANK COMMON
         BCS,15   OUTOFPGS2
         BAL,5    PAGEZAPT
*D*
*D*               WHEN EITHER LINK OR FETCH IS ENTERED, ALL OF THE
*D*               USER'S MEMORY IS SET TO DYNAMIC DATA.  LINK ASSEMBLES
*D:               THE USER PROGRAM IN THIS DYNAMIC DATA; FETCH READS THE
*D*               USER PROGRAM INTO THIS DYNAMIC DATA.  ALL PAGES THAT
*D*               HAVE BEEN ACQUIRED HAVE BEEN INCLUDED IN THE
*D*               DYNAMIC DATA PAGE COUNT.
*D*
*D*               ACCESS CODES AND JIT MEMORY DELIMITERS ARE SET FOR
*D*               THE USER BY CALLING THE 'LINKLIMS' SUBROUTINE FOR
*D*               EACH PROTECTION TYPE; DATA, DCBS, AND PROCEDURE.
*D*               THE DYNAMIC DATA PAGE COUNT IS OBTAINED AT THE START
*D*               OF THE PROCESS AND THE COUNT OF PAGES IN EACH PROTECTION
*D*               TYPE IS SUBTRACTED FROM THE DYNAMIC DATA PAGE COUNT
*D*               BY LINKLIMS.  THE REMAINDER IS COMMON PAGES AND IS SET
*D*               BACK INTO THE DYNAMIC DATA PAGE COUNT AT THE END OF THE PROCES
*D*
XIT101   LI,5     2                 GET CURRENT DYM DATA PG COUNT
         LB,9     JB:PCP,5           LINKLIMS WILL DECREMENT R9
*
* ESTABLISH DCB LOWER AND UPPER LIMITS
*
         LI,4     2                 AC
         LI,3     J:DCBLL           PROGRAM SECTION
         LI,2     HBUF+6            OVERALL LIMITS
         LI,6     2                 POINTER TO BIAS
         LI,8     TBUF+10           ROOT LIMITS
         LI,1     4                 DISPLACEMENT INTO JB:PCP
         BAL,11   LINKLIMS
*
* ESTABLISH DATA LOWER AND UPPER LIMITS
*
         LI,4     0
         LI,3     J:DLL
         LI,2     HBUF+3            OVERALL LIMITS
         LI,6     -2                USE MODULE BIAS TO ALLOW FOR LIBRARY
*                                      DATA AND BLANK COMMON
         LI,8     TBUF+6            ROOT LIMITS
         LI,1     1
         BAL,11   LINKLIMS
*
* ESTABLISH PROCEDURE LOWER AND UPPER LIMITS
*
         LI,4     1
         LI,3     J:PLL
         LI,2     HBUF+4            OVERALL LIMITS
         LI,8     TBUF+8            ROOT LIMITS
         LI,6     2
         LI,1     0
         BAL,11   LINKLIMS
         STB,9    JB:PCP,5          SET DD COUNT
*D*
*D*               JIT MEMORY DELIMITERS FOR DYNAMIC DATA ARE THEN SET.
*D*
         LB,7     HBUF              GET KEY FROM HEAD RECORD
         CI,7     X'84'             WAS IT LINKED
         BNE      OLAYLIM           NO
*D*
*D*               IF THE LOAD MODULE WAS LINKED THE DYNAMIC DATA
*D*               RESIDES IN THE AREA BETWEEN THE USER'S DATA AND
*D*               DCBS.
*D*
         LW,7     J:DUL
         AI,7     1
         LW,8     J:DCBLL           FIND BOTTOM COMMON PAGE
         CW,8     J:DCBUL           ARE THERE DCBS
         BLE      XIT11             YES
         LW,8     J:PLL             NO
         CW,8     J:PUL             IS THERE PROCEDURE
         BLE      XIT11             YES
         LW,8     J:EUP             NO-THEN USE EUP
         AI,8     1                 BECAUSE WE WILL DECREMENT IT BELOW
XIT11    CW,7     8                 MAKE SURE LOAD MODULE WAS BUILT OK
         BLE      %+3               OK
         LI,10    OUTOFUSER
         B        ABN1              GIVE HIM A6-38 ERROR
*E*
*E*      ERROR:   A6-38
*E*      MESSAGE: THE PROGRAM IS TOO BIG FOR THE ALLOWED USER AREA
*E*
         STW,7    J:DDLL            SET DYNAMIC DATA LOWER LIMIT
         STB,7    JB:TDP             AND TOP DYNAMIC PAGE
         AI,8     -1
         STW,8    J:DDUL            SET DYNAMIC DATA UPPER LIMIT
         STB,8    JB:BCP,4           AND BOTTOM  COMMON PAGE
         B        XIT34
*D*
*D*               IF THE LOAD MODULE WAS LOADED THE DYNAMIC DATA
*D*               RESIDES IN THE AREA FOLLOWING THE LAST PROCEDURE PAGE
*D*               UP TO THE END USER PAGE.
*D*
OLAYLIM  LW,7     J:EUP             FOR OVERLAY LOADER DYNAMIC DATA
         STW,7    J:DDUL            IS ABOVE PURE PROCEDURE
         LW,7     J:PUL
         CW,7     J:PLL              IS THERE ANY PROCEDURE
         BGE      OLAYI0             YES
         LW,7     J:DCBUL           OR ABOVE DCBS IF NO PROCEDURE
         CW,7     J:DCBLL            ARE THERE ANY DCBS
         BGE      OLAYI0             YES
         LW,7     J:DUL             OR ABOVE DATA IF NO PROC. OR DCBS
OLAYI0   AI,7     1
         MTW,0    HBUF+12           IS THIS A START UNDER
         BEZ      OLAYI1            NO
         LW,6     HBUF+7            GLOBAL SYMBOL TABLE
         SLS,6    -17                SIZE
         LW,5     HBUF+8            INTERNAL SYMBOL TABLE
         SLS,5    -17                SIZE
         AW,6     5                 TOTAL SIZE
         BEZ      OLAYI1
         AI,6     X'1FF'
         SLS,6    -9                # OF PAGES
         AW,6     7                 GET DDLL
         CB,6     JB:BCP,4          IS THERE ROOM
         BLE      %+2               YES
OLAYI1   LW,6     7
         STW,6    J:DDLL
         STB,6    JB:TDP
         LB,7     JB:BCP,4
OLAYLI1  AI,7     1
         CW,7     J:DDUL
         BG       XIT34
         LOAD,8   JX:CMAP,7         RELEASE COMMON PAGES HE HAD
         BAL,11   T:RVSPI           BEFORE ANE REACQUIRE THEM TO
         LW,3     8                 GET PROCEDURE AND DATA INTO
         BAL,11   T:GVGPI           CORRECT ORDER IN CLIST.
         B        OLAYLI1
*D*
*D*               IF A TCB EXISTS, THE LOCATION FOR THE DCB CHAIN IS
*D*               OBTAINED FROM THE 10TH WORD OF THE TCB.  OTHERWISE,
*D*               THE FIRST WORD OF THE DCB AREA IS ASSUMED.  ONE OR
*D*               THE OTHER IS STORED INTO J:DCBLINK UNLESS THE
*D*               DCB SIZE IS ZERO.
*D*
XIT34    EQU      %
         LI,1     0
         MTH,0    HBUF+6            DCB SIZE
         BEZ      XIT82             NO DCBS
         LH,1     HBUF+2            TCB DW ADDRESS
         BEZ      XIT81             NO TCB
         SLS,1    1                 TCB WORD ADDRESS
         LW,1     10,1              DCBLINK
         BNEZ     XIT82             GOT IT
XIT81    LW,1     J:DCBLL
         SLS,1    9
XIT82    STW,1    J:DCBLINK         LINK DCB TABLE
*D*
*D*               THE 'DCBCHK' SUBROUTINE IS CALLED TO VALIDATE THE
*D*               USER'S DCBS.
*D*
         LH,1     HBUF+6            DCB SIZE
         BEZ      XIT39             NONE
         LI,14    SBUF2VPA          GET SPECIAL BUFFER 2 FOR
         BAL,2    T:GBUF            DCB CHECKER
         LH,1     HBUF+6            RESTORE DCB SIZE
         SLS,1    1                 SIZE IN WORDS
         LI,4     SBUF2VPA
         LW,0     J:DCBLL           BUFFER WITH DCBS
         SLS,0    9                 WORD ADDRESS
         LW,10    0                 CHAIN IF NO TCB
         LW,2     J:DCBLINK
         LI,3     0                 RETURN REG FOR SEGLD DCB ADDR
         LI,5     0                 DO DCB INITIALIZATION
         BAL,11   DCBCHK
         LW,7     3                 SAVE M:SEGLD ADDRESS
         LI,14    SBUF2VPA          RELEASE BUFFER
         LI,5     0                 VIRTUAL/PHYSICAL AND SWAP GRAN
         BAL,2    T:RBUF
         AI,6     0                 ARE DCBS OK
         BNEZ     BADDCBS           NO
*D*
*D*               THE M:SEGLD DCB IS VERIFIED AND INITIALIZED
*D*
         LW,1     TBUF              SIZE OF TREE
         BEZ      XIT39             LINK AND GO-CANT BE OVERLAID
         AI,1     -12               IS M:SEGLD NECESSARY
         BEZ      XIT39             NO
         LW,6     7                 DID WE FIND ONE
         BNEZ     %+3               YES
         LI,10    0
         B        ABN2
*E*
*E*      ERROR:   B6-00
*E*      MESSAGE: THAT'S NO SEGLD DCB
*E*
         LW,3     KBUF,6
         AND,3    MASKS+17
         AI,3     -10-22            -SIZE OF DCB - 10 WORD VLP
         SW,3     6
         BGEZ     %+3
         LI,10    X'C'              NOT ENOUGH ROOM FOR VLP
         B        ABN2
*E*
*E*      ERROR:   B6-0C
*E*      MESSAGE: M:SEGLD DCB NEEDS 10 WORDS FOR VLPS
*E*
         LCI      10
         LM,7     M:XX+22           MOVE VLP TO M:SGLD DCB
         AND,8    MASKS+29          REMOVE FETCH SIGNATURE
         LCI      10
         STM,7    22,6
         LI,0     1                 ASN IN THE SEGLD DCB MUST BE
         LI,1     3                  SET TO FILE AS THE LOADER HAS
         STS,0    0,6                 BUILT IT AS DEVICE
         BAL,0    OPNDCB            OPENIT
*D*
*D*               THE START ADDRESS IS OBTAINED FROM THE HEAD RECORD
*D*               AND MOVED TO J:START.
*D*
XIT39    EQU      %
         LI,8     X'1FFFF'
         AND,8    HBUF+1            START ADDRESS FOR LOAD MODULE
         STW,8    J:START
*D*
*D*               THE TCB ADDRESS IS OBTAINED FROM THE HEAD RECORD.
*D*               IF INVALID THE USER IS ABORTED WITH ERROR CODE A6-3B.
*D*
*D*               IF VALID IT IS STORED IN J:TCB AND THE USER'S R0.
*D*
         LH,10    HBUF+2            TCB DOUBLWE WORD ADDRESS
         AND,10   MASKS+16
         SLS,10   1                 WORD ADDRESS
         LW,7     10
         BEZ      XIT38             NO TCB
         SLS,7    -9                PAGE TCB IS IN
         CLM,7    J:DLL             IS IT IN THE DATA AREA
         BCR,9    XIT38             YES
         LI,10    BADTCB            ABORT USER WITH A6-3B
         B        ABN1
*E*
*E*      ERROR:   A6-3B
*E*      MESSAGE: TCB ADDRESS NOT WITHIN DATA AREA
*E*
XIT38    STW,10   J:TCB
         LW,7     TSTACK
         STW,10   -15,7             TO USERS R0
         LI,6     0
         LC       J:CFLGS           LINK/LDTRC IN PROGRESS
         BCS,12   %+2               YES-DONT CHANGE R8
         STW,6 -7,7                 NO-ZERO R8
*D*
*D*               IF THE LOAD MODULE WAS BUILT BY THE LOADER, THE
*D*               ADDRESS OF THE 1ST WORD OF PROCEDURE IS SET IN
*D*               JITREE.  IF BUILT BY LINK, ZERO IS SET IN JITREE.
*D*
         LB,13    HBUF              GET KEY FROM HEAD
         CI,13    X'84'             WAS LOAD MODULE LINKED
         BE       %+3               YES-THERE IS NO TREE
         LW,6     J:PLL             TREE IS IN FIRST PAGE OF PROCEDURE
         SLS,6    9                  WORD ADDRESS OF TREE
         STW,6    J:TREE
*D*
*D*               THE CORE LIBRARY AND DEBUGGER NAME ARE SAVED IN THE
*D*               REGISTERS AND STEP'S DATA PAGE IS RELEASED VIA THE
*D*               T:RBUF ROUTINE IN MM.
*D*
         LCI      2                 CORE LIBRARY NAME
         LM,14    HBUF+9
         LM,8     HBUF+12           DEBUGGER  NAME
         PUSH     3,13
         LI,14    SBUF1VPA          RELEASE LINKS/STEP DATA PAGE
         LI,5     0                 RELEASE VP/PP/SWAP GRAN
         BAL,2    T:RBUF
         PULL     3,13
*D*
*D*               IF THE USER IS BATCH, A DEBUGGER IS NOT ALLOWED.
*D*               OTHERWISE THE DEBUGGER NAME, IF ANY, IS PERSERVED
*D*               IN TEXTC FORMAT IN R6/R7.
*D*
         LI,6     0                 SET FOR NO DEBUGGER
         LW,4     S:CUN
         LH,5     UH:FLG,4          USER FLAG
         CI,5     BAT               IS THIS A BATCH USER
         BANZ     XIT40             YES-DEBUGGER  NOT ALLOWED
         LD,6     8                 GET DEBUGGER NAME
*D*
*D*               IF A CORE LIBRARY IS NOT TO BE ASSOCIATED CONTROL GOES
*D*               TO XIT31 TO DETERMINE IF A DEBUGGER IS TO BE ASSOCIATED.
*D*
XIT40    EQU      %
         AI,14    0                 IS CORE LIB TO BE ASSOCIATED
         BLEZ     XIT31             NO
*D*
*D*               IF A CORE LIBRARY WAS SPECIFIED, THE P:NAME TABLE IS
*D*               SEARCHED FOR THE NAME SPECIFIED.  IF THE NAME IS NOT
*D*               FOUND, OR IF THE CORE LIBRARY BIT IS NOT SET IN P:SA,
*D*               THE USER IS ABORTED WITH ERROR CODE AA-00.
*D*
         LI,5     PPROCS
         CD,14    P:NAME,5          DOES CORE LIBRARY EXIST
         BE       XIT32
         BDR,5    %-2
TELAA    LI,1     X'AA'             NO
         B        TELLTEL
*E*
*E*      ERROR:   AA-00
*E*      MESSAGE: WHAT PUBLIC LIBRARY
*E*
XIT32    LW,8     P:SA,5
         LCF      8                 IS IT A CORE LIBRARY
         BCR,1    TELAA
         LW,1     J:DLL             IS DATA BIAS CORRECT FOR
         CI,1     JBUPVP             B00 CORE LIBRARY DATA
         BE       %+3               YES
         LI,10    X'51'             NO-GEN A5-51 ERROR
         B        OUTOFPGS+1
*E*
*E*      ERROR:   A5-51
*E*      MESSAGE: BAD DATA BIAS FOR CORE LIBRARY
*E*
*D*
*D*               IF THE CORE LIBRARY NAME IS VALID, THE 'CHKSIZE' SUB-
*D*               ROUTINE IS CALLED TO INSURE THAT THERE IS ENOUGH
*D*               PHYSICAL CORE FOR CORE LIBRARY PROCEDURE.  CHKSIZE
*D*               WILL SET THE USER'S UB:ASP WITH THE CORE LIBRARY
*D*               PROCESSOR NUMBER AND BUMP PB:REP FOR THAT PROCESSOR.
*D*
         LW,9     J:UPRIV           (IF ABORT, R9->J:UPRIV)
         LI,1     UB:ASP
         BAL,0    T:CHKSIZ          INSURE ENOUGH PCORE
*D*
*D*               IF A DEBUGGER IS ALSO NEEDED, CONTROL TRANSFERS
*D*               TO XIT12 TO ASSOCIATE THE DEBUGGER.
*D*
*D*               OTHERWISE, PB:UC FOR THE CORE LIBRARY IS INCREMENTED
*D*               (IF A DEBUGGER IS ALSO ASSOCIATED, PB:UC FOR THE
*D*               DEBUGGER WILL BE INCREMENTED BY THE ASSOCIATE
*D*               PROGRAM LOGIC T:ASP).
*D*
*D*               THE READY TO RUN BIT IS SET IN UH:FLAG AND
*D*               CONTROL PASSES TO THE GO TO USER LOGIC, ASP14,
*D*               AFTER THE USER IS REG'ED TO ASSOCIATE THE
*D*               CORE LIBRARY.
*D*
         AI,6     0                 IS DEBUGGER ALSO NEEDED
         BNE      XIT12             ASSOCIATE AND ENTER IT
         LRSETSST RTR
         MTB,1    PB:UC,5
         LW,8     J:START
         LI,6     E:AP
         BAL,11   T:REG             GET LIBRARY PROCEDURE
         B        ASP14
*D*
*D*               XIT31-- IF A CORE LIBRARY ISN'T NEEDED, BUT DELTA
*D*               IS CONTROL TRANSFERS TO XIT12.
*D*
*D*               OTHERWISE CONTROL TRANSFERS TO THE GO TO USER LOGIC
*D*               AT ASP14.
*D*
XIT31    AI,6     0
         BNE      XIT12
         LI,14    X'A500'           FOR POSSIBLE ERROR MESSAGE
         LI,7     X'80'             RUN THROUGH PCORE TEST FOR
         BAL,0    T:TOTESZ           OVERLAID PROGRAM SIZE TEST
         B        %+2               * ERROR AND NORMAL RETURNS CUZ
         B        %+3               * TOTESIZE RETURNS FUNNY
         CW,12    13                * LAST PART OF PCORE 'TEST'
         BG       ASPABRT2          * IF SIZE > PCORE -> DIE
         PLW,12   TSTACK            * GET MM'S ODD REGISTER OFF STACK
*E*
*E*      ERROR:   A5-00
*E*      MESSAGE: LOAD MODULE SIZE EXCEEDS USER LIMIT OR AVAILABLE CORE
*E*
         BAL,11   XIT31RT
         LI,5     0
         LW,8     J:START
         B        ASP14
*D*
*D*               XIT12--DELTA IS ASSOCIATED BY BUMPING AN EXTRA ENVIRONMENT
*D*               INTO TSTACK AND BRANCHING TO THE ASSOCIATE PROGRAM
*D*               LOGIC AT T:ASP WITH DELTA'S TEXTC NAME IN R6/R7.
*D*
XIT12    EQU      %
         LI,5     PPROCS
         CD,6     P:NAME,5          FIND DEBUGGER #
         BE       %+2
         BDR,5    %-2
         LW,8     P:SA,5            INSURE DEBUGGER IS ONE.
         LCF      8
         BCR,2    TELLA0            GIVE 'A0' ERROR.
         BUMP     19,1              EXTRA ENVIRONMENT FOR ASP
         LD,4     SYSACT
         LW,3     TSTACK              FIX ENVIRONMENT FOR T:ASP:
         LCI      2
         STM,4    13-15,3             R13/14 = ACCOUNT (:SYS)
         LI,2     0
         STW,2    9-15,3              R9 = 0 (LM ONLY, NOT CF)
         STB,2    J:CFLGS           RESET M:LINK FLAG.
         B        T:ASP             NAME IS IN R6/R7
         TITLE    'GO TO USER LOGIC'
*F*
*F*      NAME:    ASP14
*F*
*F*      PURPOSE: GO TO USER LOGIC
*F*
*F*      DESCRIPTION: THE GO TO USER LOGIC COMPLETES THE PROCESS
*F*               OF MAKING A USER READY TO RUN FOR BOTH THE
*F*               ASSOCIATE SHARED AND UNSHARED PROGRAM LOGIC.
*F*
*F*               INITIALIZATION OF THE JIT IS COMPLETED, THE ASSIGN
*F*               MERGE FUNCTION IS PERFORMED, AND CONTROL IS TRANSFERED
*F*               TO THE SHARED PROCESSOR OR USER PROGRAM.
*F*
*D*      NAME:    ASP14
*D*
*D*      CALL:    ENTERED AFTER ASSOCIATING A SHARED PROCESSOR VIA T:ASP
*D*
*D*               ENTERED AFTER ASSOCIATING AN UNSHARED PROGRAM VIA XIT10.
*D*
*D*      INPUT:   R4 = USER #
*D*               R8 = P:SA IF ENTERED FROM T:ASP
*D*                  = J:START IF ENTERED FROM XIT10
*D*               R10 = ADDRESS OF PROGRAMS'S TCB
*D*
*D*      DESCRIPTION:  THE START ADDRESS IS STORED IN THE ENVIRON-
*D*               MENT IN TSTACK.
*D*
ASP14    LD,2     SMFPSD            START TO PSD, (MAPPED,SLAVE)
         LC       J:CFLGS           RESTORING PROCESSOR FOR LDTRC
         BCS,8    ASP142            YES-DONT RESET START ADDR
         LCF      8                 ASSOCIATING DELTA
         BCR,2    ASP15             NO
         LI,6     X'80'
         CW,6     J:TELFLGS         IS THIS A 'START UNDER'
         BAZ      ASP19             NO-NOT JOB STEP-GO TO DELTA
         LB,6     8                 SAVE P:SA BITS FOR ASP142
         LW,8     J:START           YES-GET PROGRAM START ADDR
         STB,6    8                 RESTORE P:SA BITS
ASP15    LW,9     X1FFFF            * ONLY PUT START ADDR INTO
         STS,8    2                 * REGISTER 2
         LW,7     TSTACK
         AI,7     -17               ADDR FOR PSD IN ENVIRONMENT
         STD,2    *7                 PUT START ADDR IN ENVIRONMENT
*D*
*D*               IF ASSOCIATING TEL NO CHANGES ARE MADE TO JIT.
*D*
ASP142   LCF      8                 IS THIS A SPECIAL SHARED PROCESSOR
         BCR,4    ASP16             NO-SET UP TCB
         LH,1     UH:FLG,4
         CI,1     TIC               GOING FOR TEL
         BANZ     ASP19             YES-CAN ALSO SKIP ASSING/MERGE
         LC       8                 NO - IS IT DELTA?
         BCR,2    ASM00             NO - SKIP TCB SETUP
         LI,1     X'80'             TEST - AT JOB STEP?
         CW,1     J:TELFLGS         'START UNDER DELTA'?
         BAZ      ASM00             NO - NOT JOB STEP - SKIP TCB SETUP
         LW,1     TSTACK            POINT TO END OF FRAME
         AI,1     -19               BACK UP OVER DELTA'S ENVIRONMENT
         LC       J:CFLGS           GET FLAGS FOR LATER TEST
         B        ASP16A            GO FUMBLE R8
*                                    FOR SPECIAL SHARED PROCESSORS
*D*
*D*               UNLESS RESTORING A PROCESSOR FOR LDTRC, THE TCB
*D*               ADDRESS IS MOVED TO JIT AND TO R0 IN THE USER'S
*D*               ENVIRONMENT IN TSTACK.
*D*
ASP16    EQU      %
         LW,1     TSTACK            TCB INTO 0
         LC       J:CFLGS
         BCS,8    %+2               IF RESTORING PROC FOR LDTRC DONT
*                                   DESTROY USER REG 0
         STW,10   -15,1
         STW,10   J:TCB
*D*
*D*               R8 IN THE USER'S ENVIRONMENT IS SET TO ZERO UNLESS
*D*               M:LINK OR M:LDTRC IS BEING PROCESSED.
*D*
ASP16A   EQU      %
         BCS,12   ASP17             DONT DESTROY R8 IF LNKTRC
         LI,9     0
         STW,9    -7,1
*D*
*D*               THE SENSE SWITCH SETTINGS ARE MOVED FROM
*D*               THE JIT TO THE USER'S TCB.
*D*
ASP17    MTW,0    J:TCB             IS THERE A TCB?
         BEZ      ASM00             IF NOT, CAN'T SAVE SSW'S & XSL
         LI,2     12                GET INDEX
         LI,0     X'3F'             SIX SENSE SWITCHES
         AND,0    J:JIT+SS          GET THE SWITCHES
         STW,0    *J:TCB,2          AND STORE THEM IN THE TCB
*D*
*D*               XSL, WHICH IS SPECIFIED ON THE CCI RUN COMMAND AND
*D*               IS USED BY THE LIBRARIES TO DETERMINE IF A USER IS
*D*               TO ABORT BECAUSE OF RUN-TIME ERRORS, IS SET IN
*D*               THE USER'S TCB.
*D*
         LC       J:JIT             IF ON-LINE OR GHOST
         BCS,12   ASM00              DON'T SET XSL
         LI,2     14                INDEX XSL IN TCB
         LI,1     X'F00'
         AND,1    J:RNST            GET XSL FROM JIT
         SLS,1    -8                 AND ALIGN IT
         STW,1    *J:TCB,2             AND STORE IT IN THE TCB
*D*
*D*               IF RESTORING A SHARED PROCESSOR FOR LNKTRC, THE
*D*               ASSIGN/MERGE LOGIC IS SKIPPED.
*D*
ASM00    EQU      %
         LC       J:CFLGS
         BCS,8    ASMEND            IF RESTORING PROC FOR LDTRC ASSIGNS
*                                   BEEN DONE
*D*
*D*               THE DCB NAME TABLE IS SEARCHED FOR THE M:GO DCB.
*D*
         LI,7     0                 SET FOR NO M:GO DCB
         LW,1     J:DCBLINK         ADDRESS OF DCB NAME TABLE
         BEZ      ASM40             NONE-THERE CANT BE AN M:GO DCB
         B        ASM30
ASM20    LW,1     6                 GET LINK
ASM30    AI,1     2                 R1 = WA(NAME+1)
         LW,6     -1,1              R6 = 1ST WORD OF NAME
         BEZ      ASM40             DONE
         LB,3     6                 # OF BYTES IN NAME
         BEZ      ASM20             NOT NAME-MUST BE LINK
         SLS,3    -2                # OF WORDS IN NAME
         LB,10    *1                GET 1ST BYTE OF 2ND WORD
*                                    (FOR M:GO TEST)
         AW,1     3                 R1 = WA(DCB ADDR)
         LW,2     0,1               R2 = WA(DCB)
         CW,6     TXTMGO            IS 1ST WORD OF NAME M:GO
         BNE      ASM30             NO
         CI,10    'O'               MAKE SURE
         BNE      ASM30             NO
         LW,7     2                 YES-REMEMBER M:GO ADDR
         B        ASM30
*D*
*D*               IF THERE IS NO M:GO DCB AND THERE IS ALSO NO
*D*               ASSIGN/MERGE RECORD, THE REMAINDER OF THE ASSIGN/MERGE
*D*               LOGIC IS SKIPPED.
*D*
ASM40    LW,8     J:AMR
         OR,8     7                 A/M DISK ADDR AND/OR M:GO
         BEZ      ASMEND            NEITHER
         PUSH     7                 SAVE M:GO ADDR
*D*
*D*               J:ABUF CONTAINS THE ADDRESS OF THE ASSIGN MERGE BUFFER.
*D*               IF ZERO, SPECIAL BUFFER 2 IS OBTAINED TO BE USED
*D*               BY THE ASSIGN/MERGE LOGIC.
*D*
         LW,2     J:ABUF            IS ASSIGN/MERGE RECORD IN CORE
         BEZ      ASM50             NO-GO GET IT
         SLS,2    -9                VIRTUAL PAGE OF ASSIGN/MERGE RECORD
         LOAD,2   JX:CMAP,2         GET PHYSICAL PAGE OF ASSIGN/MERGE BUF
         CI,2     FPMC              IS THERE REALLY A PAGE THERE
         BNE      ASM80             YES
*                                   MUST READ IT BECAUSE OF TEL PROBLEM
ASM50    EQU      %
         LI,14    SBUF2VPA          GET SPECIAL BUF 2 FOR
         STW,14   J:ABUF              FOR ASSIGN MERGE RECORD
         BAL,2    T:GBUF
*D*
*D*               IF THERE IS NO ASSIGN/MERGE RECORD, THE FIRST TWO
*D*               WORDS IN THE BUFFER ARE SET TO ZERO SO IT WILL
*D*               LOOK LIKE AN EMPTY RECORD.
*D*
         LW,0     J:AMR             IS THERE A RECORD
         BNEZ     ASM60             YES
         LD,0     DOUBLEZERO        NO-ONLY HERE FOR M:GO
         STD,0    *J:ABUF            SO SET LINKS = 0 FOR OPEN
         B        ASM90             AND DONT TRY TO READ THE RECORD
*D*
*D*               OTHERWISE, THE ASSIGNS MERGED' BIT IS SET IN
*D*               J:ASSIGN, THE M:XX DCB IS INITIALIZED FOR READING
*D*               THE RECORD, AND THE T:AMRDWT ROUTINE IS CALLED
*D*               TO READ THE ASSIGN/MERGE RECORD INTO SPECIAL
*D*               BUFFER 2.
*D*
ASM60    LB,8     J:ASSIGN
         AND,8    MASKS+5
         OR,8     X80               SET 'ASSIGNS MERGED' BIT
         STB,8    J:ASSIGN
         BAL,11   CLOSEXX
         LI,13    X'1FFFF'
         LI,12    SBUF2VPA          BUFFER ADDRESS
         STS,12   M:XX+BUF
         LI,12    2048              BYTE COUNT
         STW,12   M:XX+RWS
         LI,6     M:XX              DCB ADDRESS
         LI,8     X'2D'             FPT CODE
         LI,11    ASM7              RETURN ADDRESS
         REMEMBER
         OR,11    Y8                SET STEP FLAG
         BAL,1    PUSHALL
         B        T:AMRDWT
ASM7     EQU      %
         AI,10    0
         BNEZ     ERRAMR            ERROR ENCOUNTERED
*D*
*D*               THE DEFAULT PRIVILEGE BITS ARE MOVED FROM THE
*D*               ASSIGN/MERGE RECORD INTO J:UPRIV IN JIT.
*D*
ASM80    LW,1     SBUF2VPA+AM:PRCUR GET THE DEFAULT PRIV BITS
         STS,1    J:UPRIV            AND SET THEM IN THE JIT
*D*
*D*               THE ASSIGN/MERGE LOGIC IN OPNSEG IS CALLED TO
*D*               INITIALIZE THE M:GO DCB AND/OR PERFORM THE ACTUAL
*D*               ASSIGN/MERGE FUNCTION.
*D*
ASM90    PULL     6                 ADDR OF M:GO (OR 0)
         OVERLAY  OPNSEG,3          YES-INITIALIZE M:GO AND MERGE ASSIGNS
ASMEND   EQU      %
*D*
*D*               THE BUFFER THAT WAS USED FOR THE ASSIGN MERGE RECORD
*D*               IS RELEASED; THE STEP IN PROGRESS BIT IN UH:FLG IS
*D*               RESET.  CONTROL THEN TRANSFERS TO THE SCHEDULER WITH
*D*               THE USER COMPLETELY READY TO RUN.
*D*
ASP19    LI,1     0
         STH,1    J:CFLGS           RESET LDTRC FLAGS
         XW,1     J:ABUF            RELEASE ASSIGN/MERGE BUF-IF ANY
         BEZ      TOSSEM
         LI,14    SBUF2VPA          RELEASE ASSIGN/MERGE BUFFER
         LI,5     0                 VIRTUAL/PHYSICAL AND SWAP GRAN
         BAL,2    T:RBUF
TOSSEM   BAL,11   T:PAC             SET ACCESS CODES FOR SP. SHAR. PROC.
         LW,4     S:CUN
         LH,15    UH:FLG,4
         AND,15   XBFFF             RESET STEP IN PROGRESS
         LW,1     J:UPRIV           IS SJAC SPECIFIED
         CW,1     PR:SJ
         BAZ      %+2               NO
         SETR     SJAC              YES-SET IT
         STH,15   UH:FLG,4
         CI,15    TIC
         BANZ     SSEMDEST
         CI,15    DIC
         BAZ      SSEMDEST
         LB,1     UB:DB,4
         LW,10    P:SA,1
*                                   TRANSFER CONTROL TO DELTA
DELDEST  LI,11    DELTAGO
         DESTRUCT
*                                   TRANSFER CONTROL TO USER OR PROCESSOR
SSEMDEST LI,6     E:AP
         BAL,11   T:REG
         LI,11    T:SSEM
         DESTRUCT
         TITLE    'LOGOFF/CONTINUE'
*F*
*F*      NAME:    STEP10
*F*
*F*      PURPOSE: LOGOFF/CONTINUE LOGIC
*F*
*F*      DESCRIPTION: IF LOGON ISSUED THE INTERPRETIVE EXIT WITH ZERO IN
*F*               R6, THE INTERPRETATION IS A LOGOFF REQUEST AND THE
*F*               USER IS REMOVED FROM THE SYSTEM VIA T:DELUS.
*F*
*F*               OTHERWISE IT IS TEL INDICATING A CONTINUE OPERATION.
*F*               ANY ASSOCIATED PROCESSORS ARE RE-ASSOCIATED WITH
*F*               THE USER AND THE USER IS RE-ENTERED VIA THE T:SSEM
*F*               ROUTINE IN SCHED.
*F*
*D*      NAME:    STEP10
*D*
*D*      CALL:    ENTERED FROM THE INTERPRETIVE EXIT LOGIC IF THE
*D*               EXIT WAS FOR LOG-OFF OR CONTINUE.
*D*
*D*      DESCRIPTION: IF LOGON ISSUED THE INTERPRETIVE EXIT WITH ZERO IN
*D*               R6, THE INTERPRETATION IS A LOGOFF REQUEST AND THE
*D*               USER IS REMOVED FROM THE SYSTEM VIA T:DELUS.
*D*
STEP10   EQU      %
         LW,4     S:CUN
         LB,13    UB:ACP,4          GET COMMAND PROCESSOR #
         LD,10    LOGON             TEXTC 'LOGON'
         BAL,1    CHKDRSP           IS LOGON EXITING
         B        T:DELUS           YES-DELETE USER
         LCF      J:JIT
         BCR,8    T:DELUS           IF NOT ON-LINE WIPE OUT USER
*D*
*D*               OTHERWISE IT IS TEL INDICATING A CONTINUE OPERATION.
*D*               THE DRTEL1 ROUTINE IN SCHED IS CALLED TO RESET TIC IN
*D*               UH:FLG AND DECREMENT PB:UC FOR TEL.  TSTACK IS SET TO
*D*               ONE ENVIRONMENT, THE READY TO RUN FLAG IS RESET IN
*D*               UH:FLG, AND THE IPROCS ROUTINE IN SCHED IS CALLED TO
*D*               INCREMENT THE UC FOR ASSOCIATED PROCESSORS.  THE
*D*               ACCESS CODES FOR ANY SPECIAL SHARED PROCESSORS ARE
*D*               LOADED VIA THE T:PAC ROUTINE IN MM.  AND ASSOCIATE
*D*               PROCESSOR EVENT IS REPORTED ON THE USER AND CONTROL
*D*               PASSES TO T:SSEM TO TRANSFER CONTROL TO THE USER.
*D*
         BUMP     -19,2
         LW,10    J:UPRIV           GET UPRIV FOR RESTORING SJAC.
         LRSETS   RTR
         CW,10    PR:SJ             IS SJAC SET
         BAZ      %+2               NO
         SETR     SJAC              YES-SET IT
         STH,15   UH:FLG,4
         BAL,2    IPROCS
         BAL,11   T:PAC
         LB,6     J:EXTENT          *SEE IF THIS  SHOULD BE
         CI,6     X'02'             *  TAKEN AS A FAKE 'GO'
         BAZ      SSEMDEST          *  FOR EXIT CONTROL
         LI,6     E:AP
         BAL,11   T:REG
         LI,1     X'40'             STILL REGARDED AS AN ABORT
         B        SETRNST           ###LI,14 WITH ERRMSG CODE
*
         TITLE    'DELETE USER'
*F*
*F*      NAME:    T:SCRATCH%USER
*F*
*F*      PURPOSE: TO DELETE A USER FROM THE SYSTEM FOLLOWING A
*F*               JIT SWAP ERROR.
*F*
*F*      DESCRIPTION: THE FIRST WORD OF J:JIT IS REBUILT AND CONTROL
*F*               TRANSFERS TO THE DELETE USER LOGIC IN STEPENT.
*F*
*D*      NAME:    T:SCRATCH%USER
*D*
*D*      REGISTERS: ALL REGISTERS ARE VULNERABLE.
*D*
*D*      CALL:    ENTERED FROM SCHED FOLLOWING A JIT SWAP ERROR.
*D*
*D*      INPUT:   R5 = S:CUN
*D*
*D*      OUTPUT:  R15 = 0   INDICATING ABNORMAL
*D*               R6 = 10   INDICATING USER RUNDOWN MUST BE BYPASSED
*D*
*D*      DESCRIPTION: BYTE 0 IN WORD 1 OF J:JIT IS SET WITH THE PROPER
*D*               BIT DEPENDING ON IF THE USER IS BATCH, ON-LINE OR A
*D*               GHOST JOB.  THIS IS COMBINED WITH THE CURRENT USER NUMBER
*D*               TO FORM THE FIRST WORD OF J:JIT.
*D*
*D*               R6 IS SET TO 10 TO BE USED BY THE DELETE USER LOGIC
*D*               TO BYPASS ANY RUNDOWN FUNCTIONS THAT DEPEND UPON THE
*D*               CONTENTS OF J:JIT BEING VALID.
*D*
*D*               R15 IS SET TO ZERO TO INDICATE ABNORMAL TO THE
*D*               DELETE USER LOGIC.
*D*
T:SCRATCH%USER  EQU  %
         LI,9     0
         LI,6     MAXG
SCRAT5   EQU      %
         CB,5     SB:GJOBUN,6       IS USER ASSOC WITH THIS GHOST
         BNE      %+2               NOPE
         OR,9     X40
         BDR,6    SCRAT5
         CI,9     X'40'             ITS A GHOST JOB
         BANZ     SCRAT6
         LH,8     UH:FLG,5
         CI,8     BAT               ITS A BATCH JOB
         BANZ     SCRAT6
         AI,9     ONLN              ITS A ONLINE JOB
SCRAT6   STW,5    J:JIT             INITIALIZE THE JIT USER #.
         STB,9    J:JIT             INITIALIZE THE JIT USER TYPE.
         LI,15    0                 INDICATE ABNORMAL
         LI,6     10                NO JIT-MUST SKIP SOME RUNDOWN
         B        STEPENT+1
         PAGE
*F*
*F*      NAME:    STEPENT
*F*
*F*      PURPOSE: TO DELETE A USER FROM THE SYSTEM
*F*
*F*      DESCRIPTION: STEPENT IS ENTERED FROM VARIOUS MONITORS ROUTINES
*F*               WHEN IT HAS BEEN DETERMINED THE USER IS TO BE LOGGED
*F*               OFF.  STEPENT TRANSFERS CONTROL TO THE DELETE USER LOGIC
*F*               AT STEP21.
*F*
*D*      NAME:    STEPENT
*D*
*D*      REGISTERS: ALL REGISTERS ARE VULNERABLE.
*D*
*D*      CALL:    ENTERED FROM SCHED ON A CONTEXT SWAP ERROR (R15=0)
*D*               ENTERED FROM KEYN, MEMPAR, SWAPPER (R15=-1)
*D*
*D*      OUTPUT:  R6 = 0   TO INDICATE TO THE DELTE USER LOGIC THAT
*D*                        USER RUNDOWN IS TO BE PERFORMED.
*D*
STEPENT  LI,6     0                 DO USER RUNDOWN
         LW,4     S:CUN
         B        STEP21            TO DELETE USER LOGIC
         PAGE
*F*
*F*      NAME:    T:DELUSZAP
*F*
*F*      PURPOSE: TO DELETE A USER WHO IS ABORTED DURING THE
*F*               RUNDOWN PROCESS.
*F*
*F*      DESCRIPTION:  R15 IS SET TO ZERO TO INDICATE ABNORMAL
*F*               AND CONTROL TRANSFERS TO THE DELETE USER LOGIC
*F*               IN T:DELUS.
*F*
T:DELUSZAP EQU    %
         LI,15    0                 INDICATE ABNORMAL
         B        T:DELUS+1
*F*
*F*      NAME:    T:DELUS
*F*
*F*      PURPOSE: NORMAL LOGOFF LOGIC
*F*
*F*      DESCRIPTION:  T:DELUS IS ENTERED FROM THE STEP10 ROUTINE FOLLOWING
*F*               AN INTERPRETIVE EXIT FROM LOGON WITH R6=0 INDICATING
*F*               LOGOFF.
*F*
*F*               REGISTERS 6 AND 15 ARE SET UP TO INDICATE A NORMAL
*F*               LOGOFF PROCESS AND CONTROL TRANSFERS TO THE DELETE USEER
*F*               LOGIC AT STEP21.
*F*
T:DELUS  LI,15    -1                INDICATE NORMAL
         LI,6     0                 DO USER RUNDOWN
         B        STEP21
*F*
*F*      NAME:    STEP21
*F*
*F*      PURPOSE: DELETE USER LOGIC
*F*
*F*      DESCRIPTION:  ANY OUTSTANDING RUNDOWN FUNCTIONS THAT ARE REQUIRED
*F*               ARE PERFROMED AND CONTROL PASSES TO THE RESIDENT STEP
*F*               ROUTINE 'STEP70' TO PERFORM RUNDOWN THAT CANNOT BE
*F*               EXECUTED FROM AN OVERLAY.
*F*
*D*      NAME:    STEP21
*D*
*D*      REGISTERS: ALL REGISTERS ARE VULNERABLE.
*D*
*D*      CALL:    ENTERED FROM T:DELUS AND STEPENT
*D*
*D*      INPUT:   R15 = -1  TO INDICATE NORMAL
*D*               R15 =  0  TO INDICATE ABNORMAL
*D*
*D*               R6 = 0   TO INDICATE USER RUNDOWN
*D*               R6 = 10  TO INDICATE BYPASS USER RUNDOWN
*D*                        (SET ONLY ON JIT SWAP ERROR)
*D*
*D*      DESCRIPTION:  FIRST THE TSTACK IN THE USERS JIT IS EMPTIED
*D*               TO FACILITATE THE RUNDOWN PROCESS.
STEP21   EQU      %
         LD,2     0PSD
         STD,2    TSTACK
         CW,15    Y8
         BANZ     STEP22            NORMAL DELETE
*  SINGLE USER ABORT OR SWAPPER ZAP DUE TO ERROR
         LW,5     Y4
         STS,5    J:ASSIGN          NO BUF CK
         LI,5     J:JIT
*D*
*D*               IF THERE ARE ANY OUTSTANDING ENQUEUES, A DEQUEUE
*D*               CAL IS SIMULATED.
*D*
STEP22   EQU      %
         PUSH     6
         LW,7     S:CUN
         LB,7     UB:ACP,7
         MTB,-1   PB:REP,7
         LI,0     X'100'            JIT:ENQ BIT
         CW,0     J:ABC
         BAZ      NOJENQ
         LW,7     TSTACK            PUT FPT WORDS 1-4 INTO TSTACK
         AI,7     1                 ADJUST TO WORD 1 OF FPT
         LCI      4                   WORD 0 IS NOT USED
         LM,15    NQJFPT
         PSM,15   TSTACK
         LI,8     9                 DEQUEUE FPT CODE
         BAL,11   ENQ
ENQJPUL  BUMP     -4,1
*D*
*D*               A CALL TO T:DSMT# IN MISOVSEG IS MADE TO INSURE ALL
*D*               ASSOCIATED TAPES ARE DISMOUNTED.
*D*
NOJENQ   EQU      %
         OVERLAY  MISOVSEG,T:DSMT#
*D*
*D*               ANY OUTSTANDING READ-AHEAD ENTRIES FOR THE
*D*               USER ARE RELEASED.
*D*
         LI,0     T:RAREL
         BEZ      STEP30            READ-AHEAD NOT IN THIS SYSTEM
*
RA2      LI,7     0
         LW,4     S:CUN
         DISABLE
RA4      LB,7     RAB:FLINK,7       GET NEXT ENTRY INDEX
         BEZ      RA6               ALL DONE
         CB,4     RAB:USER,7
         BNE      RA4               NOT FOR THIS USER
         INT,11   RA:DA,7
         BCS,2    RA4               AIR ENTRY
         BCR,8    RA4               NOT ACTIVE
         LI,11    0
         STB,11   RAB:USER,7        ZAP THE USER #
         BAL,10   T:RAREL           RELEASE THE ENTRY
         MTW,1    RA:ABNNN          INCR # UN-NEEDED READ-AHEADS
         B        RA2               START AGAIN
*
RA6      ENABLE
*D*
*D*               ALL PAGES REPRESENTED IN JB:LMAP ARE RELEASED BY
*D*               REPEATEDLY RELEASING THE HEAD OF THE CHAIN, JB:VLH,
*D*               UNTIL IT BECOMES ZERO.
*D*
STEP30   EQU      %                 RELEASE REMAINING PAGES
         PULL     6
         BDR,6    STEP40
STEP31   LB,7     JB:VLH
         BEZ      STEP40            DONE
         BAL,11   T:RVPI
         B        STEP40
         B        STEP31
*D*
*D*               THE USER'S AJIT PAGE IS RELEASED.
*D*
STEP40   EQU      %
*
         LW,5     S:CUN
         LH,15    UH:AJIT,5
         BEZ      STEP45
         BDR,6    STEP45
         LI,7     JAJITVP           RELEASE ADDITIONAL JIT PG
         LOAD,3   JX:CMAP,7         GRANULE IS RELEASED WITH JIT BELOW
         BAL,2    T:FPP
*D*
*D*               IF THE USER IS A GHOST JOB HIS USER'S NUMBER IN
*D*               SB:GJOBUN IS ZEROED, AND IF NOT A SYSTEM GHOST, THE
*D*               NAME IN SB:GJOBTBL IS ALSO ZEROED.
*D*
STEP45   EQU      %
*
         LC       J:JIT             CHECK FOR CHOST JOB
         BCR,4    STEP50
*                                   LOGGING GHOST JOB OFF
         LI,2     MAXG
STEP47   CB,5     SB:GJOBUN,2
         BNE      STEP48
         LI,15    0
         STB,15   SB:GJOBUN,2       ZAP USER#
         CI,2     MING              DO WE ZAP NAME TOO
         BL       STEP50            NO
         STD,15   S:GJOBTBL,2
STEP48   BDR,2    STEP47
*D*
*D*               THE SWAP GRANUALS FOR THE USER'S JIT AND AJIT ARE
*D*               RELEASED VIA T:SGR IN MM.
*D*
STEP50   EQU      %
         LB,8     J:JIT
         LH,15    UH:AJIT,5         RELEASE FOUR GRANULES
         BNEZ     %+2
         LH,15    UH:JIT,5
         BDR,6    %+2
         BAL,11   T:SGR
*D*
*D*               IF THE USER WAS OPENING OR CLOSING A FILE THE T:UBLK OCU
*D*               ROUTINE IN IORT IS CALLED.
*D*
         LW,4     S:CUN
         CW,4     OPNCLSUS
         BNE      STEP52
         LI,0     0
         BAL,11   T:UBLKOCU         DESTROYS 4 SAVES 5-10
*D*
*D*               ANY ASSOCIATED PROCESSORS ARE DISASSOCIATED. UH:FLG,
*D*               UH:FLG2 AND UH:JIT ARE ZEROED.  IF THE USER WAS ON-LINE
*D*               HIS ENTRY IN THE LINE-USER# TABLE, LB:UN, IS ZEROED.
*D*
*D*               CONTROL THE TRANSFERS TO 'STEP70' IN THE ROOT TO
*D*               COMPLETE THE DELETE USERS LOGIC.
*D*
STEP52   LW,4     S:CUN
         BAL,2    DTORP
         BAL,2    RPROCS
         LI,R6    0
         LI,R3    SCU
         STH,R6   UH:JIT,R5         JIT D. A.
         STH,R6   UH:FLG2,R5
         STH,R6   UH:FLG,R5         FLAG ITEMS
         STH,R6   UH:WL,R5          ******TEMP
         STB,R6   UB:NECB,R5        ******TEMP
         STW,R5   R11               SAVE R5 FOR STEP (ROOT)
         DISABLE                    INHIBIT
         BAL,R5   COCGLN            GET LINE # IN R2, CHECK
         B        STEP69            B/HUNG-UP SAVED USER OR NOT ONLINE
CNM      EQU      1                 SET=1 IF TP SLAVE LINES SUPPORTED
         DO       CNM
         LC       J:TELFLGS         SEE IF THIS LINE REQUESTED FOR TP
         BCR,1    STEP56            B, IF NOT; ZAP LB:UN
         LB,R1    MODE5,R2          ELSE, GET SLAVE LINE SWITCHES
         OR,R1    X4                SET 'TP-REQUESTED LINE' BIT
         STB,R1   MODE5,R2          RESTORE SLAVE LINE SWITCHES
         LI,R1    10                GIVE TP 12 SECONDS TO GET LINE
         STH,R1   EOMTIME,R2        TELL TPCOC ABOUT IT
STEP56   EQU      %
         FIN
         STB,R6   LB:UN,R2          0/LINE# -> USER# TABLE
         LH,R1    COCOC,R2          L/OUTPUT CHARACTER COUNT
         BNEZ     STEP57            BNEZ; LET COCOP RESET HANG-UP BIT
         LB,R1    MODE2,R2          L/MODE2
         AND,R1   M7                &/MODE2 W/.7F; RESET HANG-UP BIT
         STB,R1   MODE2,R2          S/MODE2
STEP57   LB,R1    MODE6,R2          L/MODE6
         CI,R1    1                 C/MODE6 W/HARDWIRE BIT
         BAZ      STEP58            B/NOT HARDWIRED; DIAL-UP
         BAL,R4   COCSTERM          SET COCTERM TO COB:CTI
         B        STEP69            B
STEP58   CW,R2    DUMPLINE          C/LINE # W/DUMP-ENABLED LINE #
         BNE      STEP69            B/NOT THIS LINE
         MTH,1    DUMPLINE          MAKE DUMPLINE AN ILLEGAL LINE #
STEP69   LW,R5    R11               L/SAVED R5
         LW,R4    S:CUN             RESTORE S:CUN
         LI,R6    0                 RESTORE R6 TO 0
         B        STEP70            B; COMPLETE RUNDOWN IN ROOT
         TITLE    'DCB CHECKER'
*F*
*F*      NAME:    DCBCHK
*F*
*F*      PURPOSE: TO VALIDATE USER'S DCBS
*F*
*D*      NAME:    DCBCHK
*D*
*D*      CALL:    IF ENTERED INTERNALLY       BAL,11  DCBCHK
*D*
*D*               IF CALLED EXTERNALLY    PUSH    0
*D*                                       PUSH    2
*D*                                       OVERLAY STEPOVRSEG,DCBCHK#
*D*
*D*      INPUT:   R0 = BUFFER ADDR OF DCB RECORD
*D*               R1 = WORD SIZE OF THE DCB RECORD
*D*               R2 = ADDR OF THE DCB NAME CHAIN
*D*               R4 = ADDR OF A CLOBBER BUFFER FOR DCBCHK TO USE
*D*               R5 = -1  NO DCB INITIALIZATION
*D*                  =  0  FULL DCB INITIALIZATION
*D*                  =  1  SPECIAL INITIALIZATION FOR TEL GET
*D*
*D*      OUTPUT:  R3 = ADDR OF M:SEGLC DCB IF FOUND
*D*               R6 = ERROR CODE OR ZERO
*D*
T:DCBCHK PULL     2                 RESTORE THE REG THAT WOULD
         PULL     0                  HAVE BEEN CLOBBERED BY OVERLAYING
         PUSH     11                SAVE RETURN
         BAL,11   DCBCHK            CHECK THE DCBS
         PULL     11                RESTORE RETURN ADDR
         DESTRUCT
*
*
DCBCHK   PUSH     9,15
         LW,15    J:DCBLL           CONVERSION FOR BUFFER NOT JDCBLL
         STW,15   J:BASE            ZAP M:* ADDRESS
         SLS,15   9
         STW,0    0,4               MAKE FIRST ADDR IN TABLE MINIMAL
         SW,15    0
         AW,1     0                 END OF DCBS
         LW,3     2                 * CHECK DCB ADDRESSES *****
         SLS,3    -9                * GET DCB ADDRESS IN R3
         CLM,3    J:DCBLL           * IS IT WHERE LOAD/LINK OK'D IT?
         BCR,9    %+3               * ALL RIGHT ---> PROCEED
         LI,9     X'F1'             * INSERT ERROR CODE
         B        DCBXBAD           * AND KICK USER OUT
         LW,3     0,2               END OF CHAIN
         SW,3     15                CONVERT TO BUFFER ADDR
         CLM,3    0                 MUST BE IN DCB AREA
         BCR,4    %+2
         BCS,2    %+3
         LI,3     X'F1'
         B        DCBXBAD
*E*
*E*      ERROR:   B6-01
*E*      MESSAGE: DCB CHAIN IS NOT IN THE DCB RECORD
*E*
         MTW,0    0,3               CAN THIS REALLY BE THE END?
         BEZ      %+3
         LI,3     X'F2'
         B        DCBXBAD
*E*
*E*      ERROR:   B6-02
*E*      MESSAGE: THE DCB NAME CHAIN MAY NOT BE LINKED
*E*
         CW,2     0                 IF TABLE NOTT AT DCBVP
         BE       %+3               THEN IT MUST BE AT END
         LW,1     2                 AND DCBS MUST BE AT DCBVP
         B        DCB0
         LW,0     3
DCB0     AI,2     1                 FIND ALL DCB ADDRESSES
         CW,2     3
         BE       DCB1              DONE
         BLE      %+3
         LI,3     X'F3'
         B        DCBXBAD
*E*
*E*      ERROR:   B6-03
*E*      MESSAGE: THE DCB NAME CHAIN IS IRREGULAR
*E*
         LB,6     *2
         BNEZ     %+3
         LI,3     X'F4'
         B        DCBXBAD
*E*
*E*      ERROR:   B6-04
*E*      MESSAGE: THE DCB HAS NO NAME
*E*
         CB,6     TXTSGLD           IS THIS SGLD
         BNE      DCB15
         LW,5     0,2
         CW,5     TXTSGLD
         BNE      DCB15
         LI,5     X'FFF00'
         AND,5    1,2
         AI,5     ' '
         CW,5     TXTSGLD+1
         BNE      DCB15
         LW,5     2,2               GET ADDRESS
         LW,7     TSTACK
         STW,5    -4,7              TRETURN TO CALLER
DCB15    EQU      %
         LW,5     0,2               DCB NAME
         CW,5     TXTCFU            IS IT M:*
         BNE      DCB16             NO
         LW,5     1,2               ADDRESS OF M:*
         STW,5    J:BASE            SAVE IT
*
DCB16    EQU      %
         AI,6     4
         SLS,6    -2
         AW,2     6                 TO DCB ADDRESS
         LW,6     0,2
         AI,4     1
         LI,5     X'1FF'            MUST NOT HAVE > 509 DCBS
         AND,5    4
         CI,5     509
         BLE      %+3
         LI,3     X'F5'
         B        DCBXBAD
*E*
*E*      ERROR:   B6-05
*E*      MESSAGE: USER HAS MORE THAN 509 DCBS
*E*
         SW,6     15                CONVERT TO BUFFER ADDR
         CLM,6    0                 IS THIS LIGGLE
         BCS,6    %+3
         LI,3     X'F6'
         B        DCBXBAD
*E*
*E*      ERROR:   B6-06
*E*      MESSAGE: THE DCB IS OUTSIDE THE BUFFER
*E*
         LW,5     4
         CW,6     -1,5              ORDER DCB ADDRESSES
         BGE      %+4
         LW,7     -1,5
         STW,7    0,5
         BDR,5    %-4
         STW,6    0,5
         B        DCB0
DCB1     EQU      %
         STW,1    1,4               END OF DCBS =
         LI,2     0                   END OF LAST DCB
         STW,2    2,4               END OF TABLE FLAG
         AND,4    MN9               BACK TO START OF TABLE
         LW,5     TSTACK            GEN THE FLAG FOR
         LW,5     -2,5                DCB INITIALIZATION
DCB2     EQU      %
         AI,4     1                 4 => DCB TO BE CHECKED
         LW,6     0,4               START OF DCB
         LW,2     1,4               END OF DCB
         BEZ      DCBX              IF ZERO, WERE DONE
         CW,6     2                 ARE DCBS EQU
         BE       DCB2              DO LAST
         AI,2     -1
         LI,R7    X'1FF'
         AND,R7   R6
         CI,R7    X'1EE'            FIRST 18 WORDS OF DCB MAY NOT
         BLE      DCB2B              CROSS A PAGE BOUNDARY
         LI,3     X'F7'
         B        DCBXBAD
DCB2B    EQU      %
         STW,2    7                 R6 AND R7 ARE WORKING LIMITS
         CW,6     J:BASE            IS THIS M:*
         BNE      DCB2C             NO
         LW,3     6                 YES
         AI,3     41                MUST BE 41 WORDS LONG
         BL       DCB2E             NO - ABORT
         AI,5     0
         BLZ      DCB2
         LI,3     40                ZERO OUT M:*
         LI,2     0
         STW,2    *6,3
         BDR,3    %-1
         STW,2    0,6
         B        DCB2
*
DCB2C    EQU      %
         AI,6     21
         CW,6     7
         BLE      %+3
DCB2E    LI,3     X'F8'             DCB NOT LONG ENOUGH
         B        DCBXBAD
*E*
*E*      ERROR:   B6-08
*E*      MESSAGE: THE DCB MUST BE AT LEAST 22 WORDS LONG
*E*
         AI,6     1
         LW,5     5                 CHECK INIT FLAG
         BLZ      NOINIT            NO INITIALIZATION
         BGZ      TELINIT           SPECIAL INIT FOR TEL GET
         B        TELINIT2
*
TELINIT  EQU      %
         LW,1     Y002
         CW,1     FCD-22,6
         BAZ      NOINIT            CLOSED - DO NOTHING
TELINIT2 LW,1     Y006              SET FCI = 0
         LI,0     0                     FCD = 0
         STS,0    FCD-22,6
*
NOINIT   EQU      %
         LW,0     KBUF-22,6
         LW,1     FLP-22,6
         AND,0    MASKS+17
         BEZ      CHKFLP            NO KBUF,CHECK FLP
         SW,0     15                MAKE A BUFFER ADDRESS
         AI,0     7
         CLM,0    6                 KBUF MUST LIE
         BCR,9    %+3
         LI,3     X'F9'
         B        DCBXBAD
*E*
*E*      ERROR:   B6-09
*E*      MESSAGE: KBUF MUST LIE WITHIN THE DCB
*E*
         AI,0     -8
         STW,0    7                 KBUF NOW END OF LIMITS
CHKFLP   AND,1    MASKS+17
         BEZ      DCB2              NO FLP, GET NEXT DCB
         SW,1     15                MAKE A BUFFER ADDRESS
         CLM,1    6                 FLP MUST LIE BETWEEN
         BCR,9    %+3
         LI,3     X'FA'
         B        DCBXBAD
*E*
*E*      ERROR:   B6-0A
*E*      MESSAGE: FLP MUST LIE WITHIN THE DCB
*E*
DCB3     EQU      %
         LW,3     0,1               GET FLP KEY WORD
         LH,2     3                 SAVE BYTE 1
         AND,3    MASKS+8           FLP LENGTH
         AW,1     3                 END OF FLP
         CI,2     X'FF'             IF LAST VLP, DONT
         BANZ     %+2                ADD 1.
         AI,1     1
         CW,1     7
         BLE      %+3
         LI,3     X'FB'
*E*
*E*      ERROR:   B6-0B
*E*      MESSAGE: FLP OVERLAPS INTO KBUF
*E*
         B        DCBXBAD
         CI,2     X'FF'             IS THIS LAST FLP?
         BAZ      DCB3              NO, GET NEXT ONE
         B        DCB2               YES, GET NEXT DCB
DCBXBAD  STB,3    11
         LI,15    0
         STW,15   J:DCBLINK
DCBX     PULL     9,15
         LB,6     11
         B        *11
         TITLE    'READ/WRITE THE ASSIGN/MERGE RECORD'
*F*
*F*      NAME:    T:AMRDWT
*F*
*F*      PURPOSE: TO READ/WRITE THE ASSIGN/MERGE RECORD
*F*
*D*      NAME:    T:AMRDWT
*D*
*D*      CALL:    ENTERED INTERNALLY FROM ASP14 TO READ THE ASSIGN/MERGE
*D*               RECORD IN ORDER TO MERGE THE DCB ASSIGNMENTS.
*D*
*D*               CALLED EXTERNALLY FROM IORT TO PROCESS THE
*D*               M:RAMR/M:WAMR CALS.
*D*
*D*      INPUT:   R6 = DCB ADDRESS
*D*               R8 = FPT CODE   '2D' IF READ
*D*                               '2E' IF WRITE
*D*               R11 = RETURN ADDRESS
*D*
*D*      OUTPUT:  R10 = ERROR CODE OR 0
*D*
*D*      DESCRIPTION: IF THE BUFFER SIZE SPECIFIED IS LESS THAN
*D*               THREE WORDS OR GREATER THAN 512, T:AMRDWT EXITS
*D*               WITH ERROR CODE 42-01.
*D*
T:AMRDWT EQU      %
         LW,13    8                 SAVE FUNCTION
*
         LI,9     X'FFF'
         LI,8     1
         STS,8    0,6               SET ASN=FILE, CLEAR HBTD
*
         LW,9     Y4
         STS,8    J:ASSIGN          RESET SPEC BUF CHK FLAG
         LW,1     RWS,6             # OF BYTES
         BLE      ERR4201           TOO SMALL
         CI,1     2048
         BLE      SET01             OK
*E*
*E*      ERROR:   42-01
*E*      MESSAGE: ILLEGAL BUFFER SIZE ON ASSIGN/MERGE READ OR WRITE
*E*
ERR4201  LI,8     1                 SUBCODE
         LI,10    X'42'             AND CODE
         B        AMERR             FOR ERROR 42-01.
*
BUFERR   LI,10    X'4A'             ILLEGAL BUFFER OR SIZE
         B        AMERR             ERROR EXIT
*D*
*D*               IF THIS A READ REQUEST, AND THE ASSIGN/MERGE RECORD
*D*               DOES NOT EXIST (J:AMR = 0), T:AMRDWT EXITS WITH
*D*               ERROR CODE '06' (EOF).
*D*
SET01    EQU      %
         LW,8     MASKS+24
         AND,8    J:AMR             GET DISC ADDRESS
         BNEZ     SET10             EXISTS, CONTINUE SET-UP OF DCB
         CI,13    X'2D'             CHECK IF THIS IS A READ REQUEST
         BNE      SET02             NO
         LI,10    6                 YES SEND EOF
         B        AMERR             ERROR EXIT
*D*
*D*               IF THIS IS A WRITE REQUEST, AND A GRANULE HAS NEVER
*D*               BEEN OBTAINED FOR THE RECORD, A GRANULE IS OBTAINED
*D*               VIA THE GBG (GET BACKGROUND GRANULE) ROUTINE IN GRAN.
*D*               IF NO GRANULE IS AVAILABLE, T:AMRDWT EXITS WITH ERROR
*D*               CODE '57'.
*D*
SET02    EQU      %
         PUSH     13
         LW,0     AMTYPE            PACK, RAD, THEN CYLINDER
         BAL,11   GBG               GET A BACKGROUND GRANULE
         PULL     13
         AI,8     0
         BNEZ     SET05             GOT THE GRANULE
         LI,10    X'57'             NO GRANULE AVAILABLE
         B        AMERR             ERROR EXIT
AMTYPE   DATA     X'8B070B'
*D*
*D*               IF THE DISK ADDRESS IN J:AMR IS NOT VALID, T:AMRDWT
*D*               EXITS WITH ERROR CODE 'A9'.
*D*
SET05    EQU      %
         STW,8    J:AMR             SAVE DISC ADR & DCT INDEX
SET10    EQU      %
         BAL,11   CHKDA
         BCR,15   ERRA9
         STW,8    8,6               CURRENT DISC ADR TO DCB
*
         LI,1     8
         STB,1    *6,1              SPECIFY 8 RECOVERY TRIES
*
         CI,13    X'2D'             CHECK FOR READ
         BNE      WRTCHK            NO, MUST BE WRITE
*D*
*D*               THE BUFFER SPECIFIED ON A READ REQUEST MUST HAVE
*D*               '00' ACCESS CODE UNLESS A COMMAND PROCESSOR IS
*D*               RUNNING (TIC IN UH:FLG) OR THE USER HAS SPECIAL
*D*               JIT ACCESS (SJAC IN UH:FLG).  IF NOT, T:AMRDWT
*D*               EXITS WITH ERROR CODE '4A'.
*D*
         LI,10    X'22'             READ CODE FOR QUEUE
         LI,0     X'1FFFF'
         AND,0    BUF,6             USER'S BUFFER ADDRESS
         LW,7     0
         SLS,7    -9                PAGE NUMBER
         BAL,11   T:IACU            CHECK ACCESS
         BCS,3    SET15             ACCESS NOT 00
*D*
*D*               IF THE BYTE COUNT IS LESS THAN 12, T:AMRDWT EXITS
*D*               WITH ERROR 42-01.  IF THE BUFFER EXTENDS BEYOND
*D*               VIRTUAL CORE, T:AMRDWT EXITS WITH ERROR 4A.
*D*
         LW,7     RWS,6
         AI,7     -1                # OF BYTES TO READ MINUS 1.
         SLS,7    -2                # OF WORDS TO READ INTO MINUS 1.
         CI,7     3                 WORD COUNT MUST BE AT
         BL       ERR4201           LEAST 3 FOR :AMCKSM CHECK.
         AW,7     0                 LAST WORD ADDRESS
         SLS,7    -9
         CI,7     X'FF'
         BG       BUFERR            ERROR - BUFFER BEYOND VIRT CORE END
         BAL,11   T:IACU            CHECK END OF BUFFER
         BCR,3    SET20             ACCESS = 00
*
SET15    EQU      %
         BAL,11   FLAGCHK           NO, CHECK FOR TIC OR SJAC
         B        BUFERR            ERROR CODE = 4A
         B        SET20             OK
*D*
*D*               IF THIS IS A WRITE REQUEST, AND IF NEITHER A COMMAND
*D*               PROCESSOR OR A USER WITH SPECIAL JIT ACCESS IS RUNNING,
*D*               T:AMRDWT EXITS WITH ERROR CODE '14'.
*D*
WRTCHK   EQU      %
         BAL,11   FLAGCHK           CHECK FOR TIC OR MASTER MODE
         B        NOWRITE
*D*
*D*               BEFORE WRITING THE A/M RECORD, COMPUTE AM:CKSM AND
*D*               STORE IT IN THE BUFFER.
*D*
         BAL,8    CAMCKSM           COMPUTE CHECKSUM IN R11
         STW,11   AM:CKSM,1         STORE IT IN THE A/M.
         LI,10    X'26'             OK, SET WRITE CODE
*D*
*D*               THE DCB IS INITIALIZED AND QUEUE IN IOQ IS CALLED
*D*               TO READ/WRITE THE ASSIGN/MERGE RECORD.
*D*
SET20    EQU      %
         LW,8     6                 VIRTUAL DCB ADR
         STB,10   8                 READ/WRITE CODE
         LW,11    BTYC
         STS,10   TYC,6             RESET TYC
         BAL,11   PUTSZBF1          RWS->BLK, BUF->QBUF.
         LI,1     BAFCN             INCR FUNCTION COUNT
         MTB,1    *6,1
         BAL,11   QUEUE
         BAL,11   IOSPIN            WAIT FOR COMPLETION
*D*
*D*               AFTER THE READ (OR WRITE), IF THE COMPUTED
*D*               CHECKSUM DOESN'T MATCH THE VALUE IN :AMCKSM, T:AMRDWT
*D*               EXITS WITH ERROR CODE A9
*D*
         BAL,8    CAMCKSM           COMPUTE CHECKSUM IN R11
         CW,11    AM:CKSM,1         DOES COMPUTED CHECKSUM MATCH?
         BNE      ERRA9             BNE; AM REC BAD
*D*
*D*               IF THE TYPE OF COMPLETION CODE IS THE DCB FOLLOWING
*D*               THE CALL TO QUEUE IS NOT 01 (NORMAL WITH I/O TRANSFER)
*D*               T:AMRDWT EXITS WITH ERROR CODE 'A9'.
*D*
SET30    LW,9     BTYC
         CW,9     TYC,6             CHECK FOR TYC > 1
         BAZ      AMEXIT
ERRA9    LI,8     0
         XW,8     J:AMR             ZERO ADDRESS IN JIT AND
         LW,1     S:CUN
         LH,1     UH:FLG,1
         CI,1     TIC               DON'T ZERO J:AMR UNLESS
         BANZ     ERRA9A              COMMAND PROCESSOR
         LW,1     TSTACK              OR STEP IS RUNNING
         LW,1     -1,1
         BLZ      ERRA9A            STEP
         STW,8    J:AMR             USER - REPLACE J:AMR
ERRA9A   LI,10    X'A9'
AMERR    DESTRUCT MSR01EXIT         ERROR EXIT
BTYC     DATA     X'00FC0000'
AMEXIT   EQU      %
         DESTRUCT MSRWRTX
*
*
NOWRITE  EQU      %
         LI,10    X'14'             ILLEGAL WRITE REQUEST
         B        AMERR             ERROR EXIT
*
CAMCKSM  EQU      %
         LI,1     X'1FFFF'          GET BUFFER
         AND,1    BUF,6             ADDRESS.
         LW,11    AM:ORG,1          COMPUTE
         AW,11    AM:LNK,1          CHECKSUM.
         B        *8                RETURN
*
FLAGCHK  EQU      %
         LW,1     S:CUN             GET CURRENT USER #
         LH,1     UH:FLG,1          GET HIS FLAGS
         CI,1     SJAC+TIC
         BANZ     FLGOK             SPECIAL JIT ACCESS
         LW,1     TSTACK
         LW,1     -1,1              GET R11 FROM PUSHALL
         BGZ      *11               NOT STEP
*
FLGOK    EQU      %
         CI,13    X'2D'             IS IT READ
         BNE      FLGOK2            NO - DON'T CHECK FURTHER
         LI,1     X'1FFFF'
         AND,1    BUF,6             USER BUFFER ADDRESS
         CI,1     SBUF2VPA          READ MUST BE HERE
         BNE      *11
FLGOK2   EQU      %
         AI,11    1                 RETURN +2 IF TESTS OK
         B        *11
         TITLE    'SUB-ROUTINES'
*
*   ROUTINE TO CATENATE USER ACCOUNT NAME FOR :PROCS KEY
*
*     ENTER WITH ADDRESS OF SOURCE IN R3, MAX SIZE IN R8, DEST DISP IN R4
*
CONCAT   EQU      %
         LI,R5    0
         LB,R6    *R2,R5            PICK UP BYTE  FROM SOURCE
         AI,R5    1                 BUMP INDEX
         CI,R6    X'40'             TEST FOR END OF STRING
         BE       *R11              B/ END, QUIT
         AI,R4    1                 BUMP INDEX FOR OUTPUT STRING
         STB,R6   KEYBUF,R4         BUILD KEY IN M:XX KEYBUF
         CW,R5    R8                HAVE WE REACHED MAX SIZE
         BE       *R11              B/ YES, RETURN
         B        CONCAT+1          LOOP 'TILL DONE
*
*   COME HERE TO ABORT USER WHO IS NOT AUTHORIZED TO
*   EXECUTE FILES OUT OF OTHER THAN :SYS
*
XOSABORT EQU      %
         LI,R10   1                 SUBCODE
RPABORT1 LI,R11   X'FFFF'           MASK
         STS,R10  J:JIT+ERO         FOR TEL
         B        TELLA2            MAJOR CODE OF X'A2'
*
*   COME HERE FOR ERR/ABN OPENING :PROCS FILE
*
RPERR2   EQU      %
         LB,R1    R10               GET CODE
         CI,R1    X'14'             IS FILE BUSY (SUPER RUNNING)
         BNE      RPOPERR           B/ NOT .14 MUST BE ERROR
         LW,R1    S:CUN             PICK UP USER NUMBER
         LI,R6    2                 2*1.2 SECS
         STW,R6   U:MISC,R1
         LI,R6    E:SL              SLEEP EVENT
         BAL,R11  T:REG             WAIT 2.4 SECS AND ....
         B        RPOPEN            ... TRY AGAIN
SENDOPS  DATA     0                 FPT FOR M:MESSAGE CAL
         DATA     X'80000000'       P1 BIT
         DATA     X'80000000'       ADDRESS OF MESSAGE IN R0
*
RPOPERR  EQU      %
         PUSH     R10               SAVE ERR/ABN FOR ABORT
         LI,R0    OPRPM             ADDRESS OF TEXTC MSG
         LW,R7    Y4                BYPASS BUFFER CHECKING
         STS,R7   J:ASSIGN
         CAL1,2   SENDOPS           TELL OPERATOR
*
ERRMSGOUT  EQU    %                 COME HERE WITH ERROR IN R10,
*                                   TO PRINT IT OUT TO OPERATOR
         LW,R0    TSTACK            ADDRESS OF TOP OF STACK...
         AI,R0    1                 WHERE MSG WILL BE
         LCI      5                 SIZE OF MSG
         LM,R1    ERRMSG
         PUSH     5,R1              PUSH MSG INTO STACK
         LW,R2    R10               PICK UP ERR/ABN CODE
         BAL,R11  ERR2BCD           CONVERT IT TO EBCDIC
         STW,R4   *TSTACK           PUT IT INTO MSG IN STACK
         LW,R7    Y4                BYPASS BUFFER CHECKING
         STS,R7   J:ASSIGN
         CAL1,2   SENDOPS           M:MESSAGE TO OPERATOR
         LI,R0    -5
         MSP,R0   TSTACK            STRIP OFF JUNK IN STACK
         BAL,11   CLOSEXX
         PULL     R10               GET ERR/ABN FOR ABORT
         LB,R10   R10               GET CODE
         B        RPABORT1          ABORT TO TELLA2
*
*   COME HERE ON READ ERRORS OF :PROCS FILE
*
RPERR1   EQU      %
         PUSH     R10               SAVE ERR/ABN FOR ABORT
         LI,5     0
         LI,14    SBUF1VPA
         BAL,2    T:RBUF            RELEASE STEP DATA PAGE
         LW,7     Y4                BYPASS BUFFER CHECK
         STS,7    J:ASSIGN
         LI,R0    RDRPM             ADDRESS OF MESSAGE FOR OPERATOR
         CAL1,2   SENDOPS           M:MESSAGE
         LW,R10   *TSTACK           PICK UP ERR/ABN , LEAVING IT IN STACK
         B        ERRMSGOUT
*
*   ERROR CODE TO BCD ROUTINE
*        INPUT ERROR CODE IN R10 AS IT COMES (E.G. 1402XXXX)
*        OUTPUT EBCDIC ERROR CODE IN R4 AS '1401'
*        R10      REMAINS UNCHANGED
*        LINK IS R11, USES R2,R3,R4,R5
*
ERR2BCD  EQU      %
         LW,R2    R10               GET CODE
         LI,R4    0
         STB,R4   R2                ZERO OUT CODE
         SLS,R2   -1                JUSTIFY SUBCODE
         LB,R4    R10               PICK UP CODE AGAIN
         STB,R4   R2                PUT IT BACK INTO R2
         SLS,R2   -16               RIGHT JUSTIFY THE WHOLE THING
         LI,R5    3                 INDEX INTO R4  (OUTPUT STRING)
TAG      SLD,R2   -4                GET A NUMBER INTO R3
         SLS,R3   -28               JUSTIFY IT
         LB,R3    HEX,R3            PICK UP CHARACTER
         STB,R3   R4,R5             BUILD UP TEXT IN R4
         AI,R5    -1                DECR INDEX
         BGEZ     TAG               B/ NOT DONE YET
         B        *R11              ALL DONE, RETURN
OPRPM    TEXTC    'UNABLE TO OPEN :PROCS FILE FOR ACCESS'
RDRPM    TEXTC    'UNABLE TO READ :PROCS FILE FOR THIS USER'
ERRMSG   TEXTC    'ERROR CODE  =  XXXX' FIVE WORDS LONG
         PAGE
*
*        NAME:    CLSDCBS
*
*        PURPOSE: TO CLOSE ALL OPEN DCBS
*
*        CALL:    BAL,0   CLSDCBS
*
*                 ENTERED FROM T:RUNDOWN TO CLOSE ALL USER DCBS.
*                 ENTERED FROM STEP00 TO CLOSE C.P. DCBS ON AN INTERPRETIVE EXIT
*
*        DESCRIPTION:  THE CLOSE-ALL ROUTINE IN CLSSEG IS CALLED
*                 TO CLOSE M:XX AND ALL DCBS FOUND VIA J:DCBLINK.
*
CLSDCBS  EQU      %
         PUSH     0
         LI,6     M:XX
         OVERLAY  CLSSEG,CLSALL#
         PULL     0
         B        *0
*
*        NAME:    CLOSEXX
*
*        PURPOSE: TO CLOSE THE M:XX DCB
*
*        CALL:    BAL,11  CLOSEXX
*
*        REGISTERS: R6 DESTROYED
*
*        DESCRIPTION:  THE M:XX DCB IS CLOSED WITH SAVE SPECIFIED.
*
CLOSEXX  LW,6     M:XX
         CW,6     Y002              IS M:XX OPEN
         BAZ      *11               NO-EXIT
         LI,6     M:XX
         PUSH     16,5
         LI,5     SAVEFPT
         LW,7     TSTACK
         BUMP     2,8
         LCI      2
         LM,8     0,5
         STM,8    1,7
         AI,7     1
         LI,8     X'15'             CLOSE CODE
         OVERLAY  CLSSEG,0
         BUMP     -2,5
         PULL     16,5
         B        *11
*
*
SAVEFPT  DATA     X'80000000'
         DATA     2
         PAGE
*
*        NAME:    OPNXX
*
*        PURPOSE: TO OPEN THE M:XX DCB
*
*        CALL:    BAL,0  OPNXX
*
*        INPUT:   R2 = ADDRESS OF ERROR/ABNORMAL ROUTINE
*
*        REGISTERS: R1-R3 AND R6-R8 DESTROYED
*
*        DESCRIPTION:  THE ERR/ABN ADDR IS STORED IN THE M:XX DCB.
*                 INPUT MODE AND FILE TYPE DCB ARE SET.  OPNSEG IS
*                 CALLED TO OPEN M:XX.
*
OPNXX    EQU      %                 R2 = ERROR/ABNORMAL ADDR
         LI,3     X'1FFFF'
         STS,2    M:XX+3            SET ERR
         STS,2    M:XX+4            SET ABN
         LI,2     X'20000'
         LI,3     X'60000'
         STS,2    M:XX+1            INPUT
         LI,2     1                 SET FILE
         STW,2    M:XX
         LI,6     M:XX
*        B        OPNDCB            FALL THROUGH
*
*        NAME:    OPNDCB
*
*        PURPOSE: TO OPEN THE M:SEGLD DCB
*
*        CALL:    BAL,0  OPNDCB
*
*        INPUT:   R6 = ADDR OF M:SEGLD DCB
*
*                 ENTERED FROM XIT10
*
*        REGISTERS: R1, R7, R8 DESTROYED
*
*        DESCRIPTION:  OPENSEG IS CALLED TO OPEN THE DCB.
*
OPNDCB   EQU      %                 R6 = A(DCB) ON ENTRY
         PUSH     0                 SAVE RETURN
         LW,1     Y8                SET FLAG SO OPEN WILL KNOW THIS
         STS,1    J:STAR             IS FETCH OPENING THE FILE
         LI,7     DOUBLEZERO+1      FPT ADDRESS
         LI,8     X'14'             OPEN CODE
         OVERLAY  OPNSEG,0          OPEN THE FILE
         PULL     0                 GET RETURN
         B        *0                 AND EXIT
         PAGE
*        NAME:    DTORP
*
*        CALL:    BAL,2  DTROP
*
*                 ENTERED FROM USER RUNDOWN, T:RUNDOWN
*                 ENTERED FROM THE DELETE USER LOGIC
*
*        DESCRIPTION:  DTROP IS CALLED FROM THE DELETE USER LOGIC TO
*                 DECREMENT PB:UC FOR THE COMMAND PROCESSOR IF TIC IS
*                 SET IN UH:FLG.  OTHERWISE PB:UC IS DECREMENTED FOR
*                 ANY OTHER ASSOCIATED SHARED PROCESSOR.
*
DTORP    LH,15    UH:FLG,4
         CI,15    TIC
         BANZ     DTEL              WILL EXIT ON R2
         B        DPROCS            WILL EXIT ON R2
*
*        NAME:    RPROCS
*
*        CALL:    BAL,2  RPROCS
*
*                 ENTERED FROM USER RUNDOWN, T:RUNDOWN
*                 ENTERED FROM THE DELETE USER LOGIC.
*
*        REGISTERS:  R0 AND R1 DESTROYED
*
*        DESCRIPTION:  PB:REP FOR ALL ASSOCIATED PROCESSORS OTHER THAN
*                 THE COMMAND PROCESSOR IS DECREMENTED.
*
RPROCS   LI,0     0                 RESET PROCS
         LB,1     UB:APR,4
         BEZ      RPROCS1
         LC       J:CFLGS
         BCS,4    RPROCS1
         MTB,-1   PB:REP,1
         STB,0    UB:APR,4
RPROCS1  STB,0    UB:APO,4
         LB,1     UB:DB,4
         BEZ      RASP
         LC       J:CFLGS
         BCS,4    RASP
         MTB,-1   PB:REP,1
         STB,0    UB:DB,4
RASP     LI,0     0
         LB,1     UB:ASP,4
         BEZ      RASP1
         LC       J:CFLGS
         BCS,4    RASP1
         MTB,-1   PB:REP,1
         STB,0    UB:ASP,4
RASP1    EQU      %
         B        0,2
         PAGE
*
* REINITIALIZE JIT MEMORY DELIMITERS
*
T:RSTLMS EQU      %
         LI,2     JBUPVP
         STW,2    J:PLL
         STW,2    J:DLL
         STW,2    J:DCBLL
         STW,2    J:DDLL
         LI,3     JBTDP
         STB,2    JIT,3
         AI,2     -1                UL>LL MEANS NO PAGES ALLOCATED
         STW,2    J:PUL
         STW,2    J:DUL
         STW,2    J:DCBUL
         LI,3     0
         STB,3    JB:PCDCB          CLEAR DCB COUNT
         STH,3    JB:PCP            CLEAR PUPE P AND DATA CNT
         B        0,4
         PAGE
*
* SPCON--SUBROUTINE TO MOVE DATA FROM SPECIAL PROCESSOR
*        (LINK OR RUNNER) DATA PAGE TO STEP DATA PAGE
*
SPCON    EQU      %
         PUSH     0                 SAVE RETURN
         BAL,0    STEP002           REMOVE LINK/RUNNER PROCEDURE
         LB,7     PB:PVA,5
         LB,6     PB:DCBSZ,5
         LB,2     PB:DSZ,5
         AW,6     2                 R6=# PGS OF DATA AND DCBS
         SW,7     6                 R7=FIRST DATA PAGE
         PUSH     2,6
         LI,14    SBUF1VPA          GET STEPS DATA PAGE
         BAL,2    T:GBUF
         LI,5     512               # OF WORDS TO MOVE
         LW,6     SPDBASE-1,5       MOVE WORD FROM SP PROC DATA PAGE
         STW,6    SBUF1VPA-1,5        TO SPECIAL BUFFER 1
         BDR,5    %-2
         PULL     2,6
         BAL,11   T:RVPI            REMOVE DATA AND DCB PAGES
         NOP
         AI,7     1
         BDR,6    %-3
         STW,6    J:DCBLINK
         STW,6    J:UPRIV           CLEAR LINK'S/RUNNER'S PRIVILEGES.
         PULL     0
         B        *0
         PAGE
*
*   ROUTINE TO REMOVE SHARED PROCESSOR PROCEDURE FROM CMAP
*      ACCESS FOR THESE PAGES IS SET TO 3
*
STEP002  EQU      %
         LW,9     5                 PROCESSOR INDEX
         BEZ      *0
         LB,7     PB:PVA,5
         LB,6     PB:HVA,5
         SW,6     7
         LI,4     3
         PUSH     3,5
         BAL,11   T:SNAC
         PULL     3,5
         LW,15    8
         LI,8     FPMC
         STORE,8  JX:CMAP,7
         AI,7     1
         BDR,6    %-2
         B        *0
         PAGE
* SET UP JIT POINTERS AND AC FOR UNSHARED PROGRAM
* FETCH OR LINK HAS LEFT PROGRAM IN CORE AS DYNAMIC DATA,SO:
*  SET JIT MEMORY POINTERS TO REFLECT LOAD MODULE SECTIONS
*  SET PROPER AC FOR EACH PROGRAM SECTION
*        R1=DISPLACEMENT INTO JB:PCP
*        R2=A(RELATIVE WORD IN HEAD FOR SIZE/BIAS)
*        R3=DW IN JIT FOR LIMITS  J:DLL/J:PLL/J:DCBLL
*        R4=AC FOR PROGRAM SECTION
*        R6=BYTE DISPLACEMENT FROM R2 FOR BIAS DW
*        R8=A(RELATIVE WORD IN TREE FOR SIZE/BIAS)
LINKLIMS LB,7     *2,6
         LH,6     *2
         BEZ      BISR4
         AW,6     0,2               SIZE+BIAS
         AI,6     -1                -1 FOR TOP LOCATION
         SLS,6    -8                TO FORM PAGE NUMBER
         AND,6    MASKS+8
         STW,7    0,3
         STW,6    1,3
         LH,6     *8                SIZE ZERO
         BEZ      BISR4             YES, DONT SET ACCESS
         LW,6     *8
         AW,6     Y00FF
         AH,6     6                 TO ALLOW FOR FORT LIB
         AND,6    MASKS+16           AND BLANK COMMON
         SLS,6    -8                TOTAL TOP PAGE
         SW,6     *3                MINUS LOWER LIMIT
         LB,2     JB:PCP,1
         AW,6     2
BISR4    STB,6    JB:PCP,1
         BEZ      *11
         SW,9     6
         B        T:SNAC
         PAGE
*
* ROUTINE TO DETERMINE IF THERE IS ENOUGH PHYSICAL CORE
* TO ASSOCIATE A SHARED PROCESSOR.  IF NOT THE USER IS ABORTED.
* OTHERWISE THE PROCESSOR TO BE ASSOCIATED IS SET AND PB:REP
* FOR THE CORRESPONDING PROCESSOR IS INCREMENTED.
*
*        BAL,0    T:CHKSIZ          R5=SHARED PROCESSOR NUMBER
*                                   R4=CUN
*                                   R1=ASP/DB/ACP/APR
*                                   R9=J:UPRIV TO RESTORE ON ABORT.
T:CHKSIZ PUSH     7                 SAVE R7
         PUSH     2,0               SAVE RETURN AND SH. PROC. TYPE
         LB,7     *1,4              GET CURRENT SETTING
         PUSH     7                   AND SAVE IT
         STB,5    *1,4              SET USER ASSOCIATED
         LI,7     0                 PHONEY PAGE NUMBER
         BAL,0    T:TOTESZ          SEE IF THERE IS ENOUGH PCORE
         B        ASPABORT          NO
         PULL     7
         PULL     2,0
         LC       J:CFLGS           DONT INCREASE USER IF RESTORING
         BCS,8    CHKSIZ2            PROCESSOR FOR LNKTRC
         CW,7     5                 SAME PROCESSOR
         BE       CHKSIZ2           YES
         MTB,-1   PB:REP,7          DECREMENT OLD
         MTB,1    PB:REP,5          INCREMENT NEW
CHKSIZ2  PULL     7
         B        *0
*
*
ASPABORT PULL     7
         PULL     2,0
         STW,9    J:UPRIV           RESTORE J:UPRIV.
         STB,7    *1,4              RESET PROCESSOR THAT WASN'T ASSOCIATED
         PULL     7
         CI,1     UB:ACP            * AM I ASSOCIATING TEL?
         BNE      ASPABRT1          * NOPE, GIVE A508
         LW,1     Y002              * FORCE EXTEND BIT
         STS,1    J:TELFLGS         * IN J:TELFLGS
         LI,14    X'A500'           * AND A DECENT ERROR TYPE
         B        ASPABRT2          * GO KILL USER
ASPABRT1 EQU      %
         LI,14    X'A508'           GEN NO PCORE ERROR
ASPABRT2 SCS,14   -8
         B        T:ABORTM
*E*
*E*      ERROR:   A5-08
*E*      MESSAGE: PHYSICAL CORE NOT AVAILABLE FOR SHARED PROCESSOR
*E*
         PAGE
*
* READ LMN
*
FETCH1   LB,2     LMKEY
         STB,10   LMKEY,2
         LW,10    7                 SAVE SIZE, BIAS
         LH,6     7
         BEZ      BISR2
         AW,6     7
         AI,6     X'FF'
         SLD,6    -8
         AND,7    MASKS+8
         AND,6    MASKS+8
         LI,1     OUTOFUSER
         CW,6     J:EUP
         BG       FETCH3
         SW,6     7
         CW,7     J:BUP
         BL       FETCH3
         BAL,11   T:GNVPI
         BCS,15   OUTOFPGS2         PROGRAM TOO LARGE FOR USERS CORE
*
*        PAGE CLEANING IS DONE AS FOLLOWS
*                 STANDARD LMN CLEANS 1ST AND LAST PAGE ONLY
*                 PAGED LMN CLEANS ALL PAGES
*
         PSW,10   TSTACK            WILL RETURN TO R7
         LB,11    JB:PRIV           CHECK HERE TO SAVE TIME
         CI,11    GZPRIV
         BAZ      FETCH45           SKIP CLEANING
         LW,0     HBUF              IS IT PAGED LMN
         BGZ      %+3
         BAL,5    PAGEZAPT          85-TYPE CLEANS ALL
         B        FETCH45
         LW,2     7                 REGULAR LMN
         AW,2     6                 R2=LAST PAGE
         BAL,5    PAGEZAP0          CLEAN 1ST
         AI,2     -1
         CW,2     7                 ONLY 1 PAGE
         BE       FETCH45           DONE
         LW,7     2                 PAGE TO CLEAN
         BAL,5    PAGEZAP0          LAST
FETCH45  PLW,7    TSTACK
         LH,6     7                 GET SIZE OF RECORD
         SLS,7    1
         AND,7    MASKS+17
         AND,6    MASKS+16
         SLS,6    3                 TO BYTES
         LW,1     Y4
         LW,0     HBUF              GET KEY ADDR AND 85 FLAG
         BGZ      FETCH6            NOT 85TYPE
         AND,0    MASKS+16
         LW,2     7
         SLS,2    -9
         MTB,3    2                 GEN A KEY
         XW,2     *0
         LI,3     0
FETCH5   LW,1     Y4
         STS,1    J:ASSIGN
         LW,5     0                 SAVE R0 IN NON-VOL REG
         BAL,11   READ
FCH55    AI,3     1                 INCR # PGS READ
         SW,6     M:XX+13           DECR SIZE BY RWS
FCH56    EQU      %
         AI,7     X'200'            INCR BUF ADDR
         AND,7    X1FE00            MAKE PAGE IN CASE FIRST WASNT
         LW,0     5                 RETRIEVE R0
         MTW,1    *0
         CI,6     0                 ARE WE DONE
         BGZ      FETCH5            NO
         XW,2     *0
         CI,3     0                 ANY LUCK
         BEZ      ABN1              NO, ERROR
         B        *9                YES,RETURN
FETCH6   EQU      %
         STS,1    J:ASSIGN
         BAL,11   READ
BISR2    RES      0
         B        *9
         PAGE
*
*        ROUTINE TO READ  THE OPEN FILE
*        BY BUMPING A PLIST INTO THE STACK:
*        IN: R7 = BUFFER
*            R6 = SIZE
*            R0 = KEY ADDRESS
*
READ     EQU      %
         PUSH     8,4               SAVE WORKING REAG
         LW,5     TSTACK            PLIST ADDRESS
         BUMP     4,8
         STW,7    2,5               BUFFER
         STW,6    3,5               SIZE
         STW,0    4,5               KEY
         LW,9     READFPT           FIRST WORD OF PLIST
         STW,9    1,5
         LW,7     5
         LI,8     X'10'             READ
         LI,5     J:JIT
         LI,6     M:XX              DCB ADDRESS
         LI,10    0                 FOR ERROR DETECTION
         BAL,11   MSRRDWT
         BUMP     -4,4
         LW,2     10
         PULL     8,4
         LW,8     11
         LW,10    2                 ERR CODE AND DCB
         BNE      *M:XX+3           YEP, GO TO ERROR ADDRESS
         B        *11               NO,RETURN
         PAGE
*
*        STEP ERROR ROUTINES
*
*
*E*
*E*      ERROR:   A5-00
*E*      MESSAGE: LOAD MODULE SIZE EXCEEDS USER LIMIT OR AVAILABLE CORE
*E*
*E*      ERROR:   B5-00
*E*      MESSAGE: LOAD MODULE SIZE EXCEEDS USER LIMIT OR AVAILABLE CORE
*E*
OUTOFPGS EQU      %                 ENTRY POINT IF SP BUFF 1 NOT USED
         LI,10    0
         LI,1     X'A5'
         B        ABN11
OUTOFPGS2 EQU     %                 ENTRY POINT IF SP BUFF 1 USED
         LI,10    0
         LI,1     X'A5'
         B        ABN1+1
**E*
**E*     ERROR:   A6-XX
**E*     MESSAGE: DESCRIBES ERROR WITH LOAD MODULE FILE
**E*
FETCH3   LW,10    1
         B        ABN1
**E*
**E*     ERROR    B6-XX
**E*     MESSAGE: DESCRIBES ERROR DETECTED BY THE DCB CHECKER
**E*
BADDCBS  LW,10    6
         AND,10   MASKS+4
ABN2     LI,1     X'B6'
         B        ABN1+1
*E*
*E*      ERROR:   A6-03
*E*      MESSAGE: LOAD MODULE DOES NOT EXIST
*E*
*E*      ERROR:   B5-03
*E*      MESSAGE: LOAD AND LINK CAN'T FIND YOUR FILE.
*E*
OPNERR   LI,1     X'A6'
         LB,10    10
         B        ABN11
*E*
*E*      ERROR:   A6-42
*E*      MESSAGE: THAT'S NO LOAD MODULE
*E*
*E*      ERROR:   A6-43
*E*      MESSAGE: THAT'S NO LOAD MODULE
*E*
*E*      ERROR:   A6-46
*E*      MESSAGE: CAN'T FIND REQUESTED PROGRAM
*E*
ERRTN    EQU      %
         LB,1     10                IF NOT 46 GET REAL ABN/ERR
         CI,1     X'46'
         BNE      %+2
         SLS,10   7                 GET SUBCODE, NOT 46
         LB,10    10
         CI,10    7
         BE       *8
         CI,8     FCH55             IS THIS 85-READ
         BNE      ABN1              NO
         CI,10    X'43'
         BNE      ABN1
         AI,6     -X'800'           MISSING PAGE FROM 85-TYPE
         B        FCH56             DECR SIZE AND CONTINUE
*
* RELEASE BUFFER AND REPORT ERROR
*
ABN1     EQU      %
         LI,1     X'A6'
         LI,14    SBUF1VPA          RELEASE STEP DATA PAGE
ABN1A    PUSH     1
         PUSH     10
         LI,5     0
         BAL,2    T:RBUF            RELEASE VP/PP/SG
         LI,2     0
         LI,3     X'20000'
         STS,2    J:ASSIGN
         BAL,11   CLOSEXX
         PULL     10
         PULL     1
ABN11    EQU      %
         CI,10    X'80'
         BAZ      %+3
         LW,1     10                NON-I/O CODE USE IT
         LI,10    0                 NO SUBCODE
         LI,11    X'FFFF'
         STS,10   JIT+ERO           STORE SUBCODE
         LW,11    Y003E             SET MONITOR RUNNING UNLESS
         STS,10   J:RNST            GOING FOR DELTA
         LC       J:CFLGS
         BCR,12   TELLTEL           NOT LDLNK
*E*
*E*      ERROR:   B5-XX
*E*      MESSAGE: SEE STEP (ERROR CODES A5 AND A6) SUBCODES AND I/O ERROR CODES
*E*
         LI,1     0
         STH,1    J:CFLGS
         LI,1     X'B5'
         B        TELLTEL
*E*
*E*      ERROR:   A9-00
*E*      MESSAGE: ERROR ON READ OR WRITE OF ASSIGN/MERGE RECORD
*E*
ERRAMR   EQU      %
         PULL     6                 BALANCE STACK.
         LW,1     S:CUN
         LH,1     UH:FLG,1          IS TIC SET
         CI,1     TIC
         BANZ     ASMEND            YES
         LI,14    SBUF2VPA          MUST RELEASE BUFFER
         LB,1     10                GET ERROR CODE
         LI,10    0
         STW,10   J:ABUF            BECAUSE WE ARE GOING TO RELEASE IT
         CI,1     X'A9'             IS IT AM READ ERROR
         BE       ABN1A
         STW,1    10
         LI,1     X'A9'             SET SO A9 IS MAJOR
         B        ABN1A
         PAGE
TELLA2   LI,1     X'A2'             NO ACCESS TO COMMAND PROCESSOR
         B        TELLTEL
TELLA0   LI,1     X'A0'             INVALID DEBUGGER NAME
         B        TELLTEL
*
TELLA101 LI,14    1
         LI,15    X'FF'
         STS,14   JIT+ERO
*
TELLA1   LI,1     X'A1'             DONT ASSOC DEBUGGER WITH SHRD PROC
*
TELLTEL  STB,1    J:ABC
         LW,4     S:CUN
         LD,14    19PSD             TEL NEEDS ONE ENVIRONMENT
         STD,14   TSTACK            TO LOOK AT
         BAL,2    IPROCS
         LB,14    J:ABC
         LW,15    JIT+ERO
         STB,15   14
         B        T:ABORTM
         PAGE
*
*        NAME:    CHKDRSP
*
*        PURPOSE: TO FIND A PROCESSOR IN THE P:NAME TABLE THAT HAS
*                 BEEN REPLACED BY DRSP WHILE A USER ASSOCIATED
*                 WITH THAT PROCESSOR WAS IN EXECUTION.
*
*        CALL:    BAL,1  CHKDRSP
*                 RETURN IF PROCESSOR WAS ASSOCIATED
*                 RETURN IF PROCESSOR WAS NOT ASSOCIATED
*
*        INPUT:   R10/R11 = PROCESSOR NAME
*                 R13 = PROCESSOR #
*
*        REGISTERS:  R5, R12, R13 DESTROYED
*
*        DESCRIPTION: WHEN DRSP REPLACES A SHARED PROCESSOR, THE P:NAME
*                 ENTRY FOR THE OLD PROCESSOR IS REPLACED WITH THE
*                 ORIGINAL PROCESSOR INDEX IN WORD 1 AND THE NEW
*                 PROCESSOR INDEX IN WORD 2.
*
*                 'CHKDRSP' RUNS THROUGH THE DRSP LINKS IN THE
*                 P:NAME TABLE TO FIND THE SPECIFIED PROCESSOR.
*
CHKDRSP  LW,5     13                IS ANY PROCESSOR ASSOCIATED
         BEZ      1,1               NO-EXIT
         LD,12    P:NAME,5          GET PROCESSOR NAME
         CD,12    10                IS IT THE SAME AS ONE SPECIFIED
         BE       0,1               YES-SPECIFIED PROC. IS ASSOCIATED
         CW,12    5                 HAS PROCESSOR BEEN REPLACED BY DRSP
         BE       CHKDRSP           YES-KEEP LOOKING
         B        1,1               NO-PROCESSOR NOT ASSOCIATED
STPOVRSZ EQU      %-STPNR:
         END      STPOVR

