STPNR:   EQU      %
         DEF      STPNR:
MONPROC  SET      1
         SYSTEM   UTS
         DEF      STPOVR
STSIZ    EQU      %
         B        STPOVR
*
*     OVERLAY PORTION OF STEP
*
*
*                                   ASP,STEP
*                                   EXIT,ERROR,ABORT
*                                   FETCH
*                                   ASSIGN MERGE
*
*
* PROC REFS
*
*        PB:HVA = VP# OF 1ST UNUSED PAGE
*        PB:PVA = VP# OF 1ST PROC PAGE
*        P:NAME = PROC ROOT OR MON OVERLAY TABLE
*        PB:REP = #USERS ASSOC. W PROCESSOR/OVERLAY
*        P:SA = FLAGS & START ADDR OF ENTRIES IN P:NAME
*        PB:DCBSZ = #PGS OF DCBS
*        PB:DSZ = #PGS OF DATA
*        PB:PSZ = #PGS OF PURE PROCEDURE REQUIRED
*        PB:LNK = PROC # OF NEXT OVERLAY (0=NONE)
*        PB:UC = #USERS IN CORE ASSOC. W PROCESSOR/OVERLAY
*        P:TCB = PROC TCB ADDR (0=NONE)
*
        REF      PB:HVA
        REF      PB:PVA
         REF      PPROCS
         REF      P:NAME
         REF      PB:REP
         REF      PNAMEND
         REF      P:SA
         REF      PB:DCBSZ
         REF      PB:DSZ
         REF      PB:PSZ
         REF      PB:LNK
         REF      PB:UC
         REF      P:TCB
         REF      MAXOVLY
*
* JIT REFS
*
         REF      J:STAR,J:EXLY
         REF      J:JIT
         REF      SCU
         REF      J:DCBLINK
         REF      M:UC
         REF      J:ASSIGN
         REF      J:RNST
         REF      J:ABC
         REF      J:INTENT
         REF      J:USENT
         REF      J:TCB
         REF      JB:FBUL,JBCBLL
         REF      SBUF1VPA,SBUF2VPA
         REF      JBUPVP,JEUPVP,JOVVP
         REF      JXBUFVP,JH:LDCF
         REF      JBNFPOOL,JBUPVPA
         REF      DOUBLEZERO
         REF      J:START
         REF      J:LMN
         REF      J:CLM
         REF      J:TELFLGS
         REF      J:ACCN
         REF      JX:CMAP
         REF      JB:VLH
         REF      J:AMR
         REF      J:BUP
         REF      J:EUP
         REF      J:DLL
         REF      J:DUL
         REF      J:PLL
         REF      J:PUL
         REF      J:DDLL
         REF      J:DCBLL,J:DCBUL
         REF      J:BASE
         REF      J:DDUL
         REF      JB:PCP
         REF      JIT,JBTDP,JBBCP
         REF      JAJITVP
         REF      JB:LMAP
         REF      JB:TDP
         REF      J:ABUF
         REF      JITREE
         REF      J:CFLGS
         REF      MN9
         REF      J:MRT
         REF      MPPO,MPO,MDPO,MUPO
         REF      TMDCRM,TMDPRM
         REF      PRDCRM,PRDPRM
         REF      TMPDCPK,TMPDPPK
         REF      J:EXTENT
         REF      JB:STEPCC
         REF      JB:STEP
         REF      ALOCCT            ACCNTNG FOR PERM. XTNDED
JB:BCP   EQU      JB:TDP
         REF      M:XX,MXFPL,MXKB
         REF      ERO
*
         REF      J:TIMENT
         REF      M24
         REF      OPNSEG
         REF      CLSSEG
         REF      MSRRDWT
         REF      T:UBLKOCU
* SCH REFS
*
         REF      S:CUN
         REF      E:AP
         REF      T:REG
         REF      T:SSEM
         REF      IPROCS
        REF      ISTEL1
        REF      DRTEL1
         REF      DELTAGO
         REF      DASP
         REF      DTEL
         REF      DPROCS
         REF      T:UTSXTS
         REF      JTSTACKSZ
         REF      S:ACORE
         REF      S:PCORE
*
* USER REFS
*
*
*        UH:FLG,UH:FLG2 = USER FLAGS
*        UH:AJIT = ADDIT. JIT DISK ADDR
*        UB:ACP = COMMAND PROC. # (ALLOCAT,RBBAT =0)
*        UB:ASP = SPECIAL SHARED PROCESSOR #
*        UB:APR = PROCESSOR #
*        UB:APO = PROCESSOR OVERLAY #
*        UH:JIT = USER JIT DISK ADDRESS
*        UB:DB = PROC # OF DEBUGGER
*
         REF      UH:FLG
         REF      UH:FLG2
         REF      UH:AJIT
         REF      UB:ACP
         REF      UB:ASP
         REF      UB:APR
         REF      UB:APO
         REF      UH:JIT
         REF      UB:DB
*
* MMREFS
*
         REF      T:GBUF,T:RBUF,T:ZBUF
         REF      T:SGR
         REF      T:RVPI
         REF      T:GNVNPI
         REF      T:GNVPI
        REF      T:RVSPI
        REF      T:GVGPI
         REF      T:SNAC
         REF      T:FPP
         REF      FPMC
         REF      T:PAC
         REF      T:SAC
         REF      T:GPPS
         REF      T:TOTESZ
         REF      T:GVP
         REF      T:FVP
         REF      T:SAD
         REF      T:GDP
         REF      T:FDP
         REF      T:GCP
         REF      T:FCP
         REF      T:SMP
         REF      T:GL
*
*  SYSGEN LIMITS FOR EXTENDED PROCESSING
*
         REF      SL:ETIME
         REF      SL:ELO
         REF      SL:EPO
         REF      SL:EDO
         REF      SL:EUO
         REF      SL:ETS
         REF      SL:EPS
*
* MISC REFS AND SREFS
*
         REF      COCLN
         SREF     LB:UN
         REF      JB:PCW            PLATEN WIDTH
         SREF     MODE3
         REF      SPPBASE
         REF      SPDBASE
         REF      JB:PROMPT
         REF      T:DSMT#
         REF      S:GJOBTBL
         REF      MAXG,MING
         REF      SB:GJOBUN
         REF      RCVUSER
         REF      LDLNKSEG,MISOVSEG
         REF      DEBUGSEG
         REF      ONLN
         REF T:GHOST#
         REF      DCT24
         REF      DCT9
         REF      OPNCLSUS
         SREF     MODE2
         REF      TXTCFU
         REF      0PSD
         REF      Y003E
         REF      SYSACT
         REF      DCT3,JACCN,JUNAME
         REF      HEX
         REF      XIT31RT
         REF      STEP70
         REF      Y4
         REF      M31
         REF      XFFFF00
         REF      SS
         REF      YFF
         SREF     LNOL
         REF      UH:WL
         REF      UB:NECB
         REF      PUSHALL
         REF      S:CRASHUN
         REF      DID
*
* REAL-TIME
*
         REF      J:ICBHDR
         REF      RTRNDWN#,RTNRRTSEG
         REF      S:RTCORE
*
* DATA
*
         REF      Y008
         REF      M8
         REF      Y00FF
         REF      Y03,Y04
         REF      Y07
         REF      Y8
         REF      Y001
         REF      Y002
USER     EQU      Y001
PROC     EQU      Y002
         REF      Y004
         REF      YFFF
         REF      M15
         REF      M16
         REF      X1FE00
         REF      M17
         REF      M4
         REF      M5
         REF      XFC
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
         PAGE
*
*        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 |
*        |-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-|
*          | | | | | | | |
*          | | | | | | | > 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
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'
TXTMD    DATA     X'04D47AC4'       M:D
X17      DATA     X'17'
HEADMASK DATA     X'78FF0000'
*
*        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'
FF7FFFFF EQU      NB31TO0+24
XBFFF    EQU      NB31TO0+15
XFBFF    EQU      NB31TO0+11
XFFBF    EQU      NB31TO0+7
XFFFE    EQU      NB31TO0+1
XFFF7    EQU      NB31TO0+4
XFF7F    EQU      NB31TO0+8
XF7FF    EQU      NB31TO0+12
X1000    EQU      BT31TO0+13
X2000    EQU      BT31TO0+14
X800     EQU      BT31TO0+12
XEFFF    EQU      NB31TO0+13
         PAGE
*
*     DRIVER FOR OVERLAY PORTION OF STEP
*
STPOVR   EQU      %
         AI,0     DRIVE
         B        *0
DRIVE    EQU      %
         B        T:EXIT
         B        T:ERROR
         B        T:ABORT
         B        XCONSETUP
         B        KICKOFF
         B        RUND
         B        T:SCRATCH%USER
         B        T:ASP
         B        ASP1
         B        NOCPPGS
         B        T:DEL
         B        T:ECCP
         B        T:TELDELCCI       T:ABORTM,SETRNST DONE IN RT
         B        STEPENT
         B        PREPDCB
         B        T:AMRDWT
*           ENTRY TO MM OVERLAY
         B        T:GVP
         B        T:FVP
         B        T:SAD
         B        T:GDP
         B        T:FDP
         B        T:GCP
         B        T:FCP
         B        T:SMP
         B        T:GL
         RES      10
PREPDCB  PULL     2                 REGS SAVED IN CALLING
         PULL     0                 DCBCHK
         PUSH     11                SAVE RETURN
         BAL,11   DCBCHK
         PULL     11
         DESTRUCT
         PAGE
*
*        STEP EXIT LOGIC
*
*
T:EXIT   EQU      %
*
* EXIT CAL
*
         LW,4     S:CUN
         LH,15    UH:FLG,4
         LB,7     UB:ASP,4          CHECK FOR RUNNER EXITS
         LW,5     7
         BEZ      1A1               NO ASP
         LD,6     P:NAME,5
         CD,6     NRUNNER
         BE       STEP003
         CW,6     5
         BE       %-6               CHECK LINKED SLOT
1A1      EQU      %
         CI,15    TIC               COMMAND PROC IN CONTROL MEANS
         BANZ     STEP00            STEP FUNCTION. B IF YES
         LI,14    0
         LI,1     0                 CLEAR RUN STATUS
         B        SETRNST
*
* ERROR CAL
*
T:ERROR  EQU      %
         LI,1     X'80'             SET RUNSTATUS TO ERROR CAL
         LI,14    X'A8'
         B        SETRNST
*
* ABORT CAL
*
T:ABORT  EQU      %
         LI,14    X'A8'
         LW,4     S:CUN
         LI,1     X'40'
         LH,15    UH:FLG,4
* MIGHT HAVE TO LET XCON TAKE PRECEDENCE EVEN FOR COMM.PROC.
         CI,15    TIC
         BAZ      SETRNST
         B        RUND
*
* MONITOR ABORTING USER
* ABORT CODE IN REG 14
*
T:ABORTM EQU      %
         LI,1     1
         PAGE
SETRNST  STB,1    J:RNST
T:TELDELCCI EQU   %
         LW,0     S:CUN
         SW,0     OPNCLSUS
         BNEZ     %+2
         BAL,11   T:UBLKOCU
*  STEP NOW HAS TO SET UP THE STEP CC IF THE USER HAS NOT
* EXPLICITLY DONE SO VIA M:EXIT,M:ERR,M:XXX.
*  USED TO BE DONE FOR BATCH ONLY IN CCI
         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        XCONSEE
SETSTCC  EQU      %
         LI,1     BA(JB:STEPCC)
         LI,15    0
         STB,15   0,1
         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      %
XCONSEE  EQU      %                 SEE IF XIT CONTROL
         REF      J:RWECB,E:QMF,ECBPOST1,ECBFBLK
         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.
         LW,2     7
         BLZ      NOTXECB
         BAL,1    ECBFBLK           FREE BLOCK IF NECESSARY.
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
         AND,3    J:EXTENT          CHK XIT CONTROL ADDRESS
         BEZ      NOXCON
         LB,3     J:EXTENT          SEE IF  CON IN PROG.
         CI,3     X'20'
         BAZ      NOTINPRO
         LB,1     J:RNST            IF IN PROG.,SEE IF
         CI,1     X'3F'             .M:EXIT,M:ERR OR M:XXX
         BAZ      NOXCON
NOTINPRO EQU      %
         LW,4     S:CUN             *PROVISIONS FOR C.P. TAKING
         LH,15    UH:FLG,4          * EXIT CONTROL
         CI,15    TIC               * AND CONDITION:
         BAZ      NOTCP             *   C. P. IN CONTROL/
         CI,3     X'10'                EXIT CONTROL SET BY C.P.*
         BAZ      NOXCON
         B        NOTCP+2
NOTCP    EQU      %
         CI,3     X'10'
         BANZ     NOXCON
         LB,1     J:RNST            YES;CHK EXIT CONDITION
         BEZ      XCONSETUP         GO SET UP;EXIT/LINK/LDTRC
         CI,1     X'04'
         BE       XCONCLS2          IT IS A LIMIT EXCEEDED COND.
         CI,1     X'18'
         BAZ      XCONSETUP         ERR/MERC/E KEYIN/TRAP/MON DET ERR/
         LW,3     J:EXTENT          IT IS A X KEYIN/HANGUP/
         BLZ      KICKOFF           ABORT BIT PREV.SET;KILL III ON III
         LW,3     Y8
         STS,3    J:EXTENT          SET THE ABORT/HANGUP BIT
         LC       J:EXTENT
         BCS,4    XCONSETUP         LMT XCEEDED BIT PREV. SET
*  CORRECTLY SET UP THE HARD TIME LIMIT AND INCREMENT
*  LO,PO,DO,UO,TSTORE,PSTORE BY SYSGEN VALUES(ASSUME NO OVFLW)
*  NOTE: LO,PO,DO,UO VALUES ARE CONTAINED IN LEFT 15 BITS
*      : ACCNTSUM HAS TO BE CHANGED TO DO CORRECT ACCOUNTING
TIMELMT  LW,2     SL:ETIME
         AWM,2    J:MRT             SET MAX TIME
LMTINC   EQU      %
         LW,2     SL:ELO
         AWM,2    J:JIT+MPPO        INCR. LO
         LW,2     SL:EPO
         AWM,2    J:JIT+MPO         INCR. LO
         LW,2     SL:EDO
         AWM,2    J:JIT+MDPO        INCR. DO
         LW,2     SL:EUO
         AWM,2    J:JIT+MUPO        INCR. UO
         LW,2     SL:ETS            INCR. TSORE
         AWM,2    J:JIT+TMDCRM      (RAD)
         AWM,2    J:JIT+TMDPRM      (PACK)
         AWM,2    J:JIT+TMPDCPK     RIGHT HALF WORD
         AWM,2    J:JIT+TMPDPPK
         LW,2     SL:EPS            INCR. PSTORE
         AWM,2    J:JIT+PRDCRM      (RAD)
         AWM,2    J:JIT+PRDPRM      (PACK)
         LI,3     X'1FFFF'          SL:EPS HFWD VALUE
         STS,2    J:JIT+ALOCCT      REM. HOW MUCH EPS IS INCMNTED
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)
         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
         LW,14    J:ASSIGN
         LI,15    X'1FF'
         STS,14   11,7              R9,BITS 23-31= LIMIT XCEED BITS
         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
         B        SSEMDEST
XCONCLS2 EQU      %                 LIMIT EXCEEDED CONDITION
         LC       J:EXTENT          IF LIMITS PREV. XCEEDED,KILL
         BCS,12   XCONKICK
         LW,3     Y4
         STS,3    J:EXTENT          SETUP THE LIMIT EXCEEDED BIT
         LC       J:JIT
         BCR,8    TIMELMT           IF BATCH,SET TIME & LIMITS
         B        LMTINC            IF ONLINE,DO NOT YET SET TIME
XCONKICK EQU      %
         LC       J:JIT
         BCR,8    KICKOFF           BATCH,NO MORE JOB STEPS ALLOWED
         LC       J:EXTENT          ON-LINE
         BCS,8    KICKOFF           .ABORT/HANGUP SET,KICKOFF
         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.
         LD,2     38PSD
         STD,2    TSTACK
         B        T:RUNDOWN
NOXCON   EQU      %
         LB,2     J:RNST            SEE IF IS A OP. ABORT OR
         CI,2     X'18'             A LINE HANGUP
         BANZ     KICKOFF+2         YES
         LB,2     J:EXTENT          SEE IF ABORT/LMT PREV. SIGNALED
         CI,2     X'C0'
         BANZ     XCONKICK          HAVE TO LOOK FURTHER
ASISNOW  EQU      %
         SPACE    4
         LW,4     S:CUN             IF A DEBUGGER IS IN CONTROL
         LH,15    UH:FLG,4          GIVE THE E, E OR A TO IT
         LD,2     38PSD
         STD,2    TSTACK
         LCF      J:JIT
         BCR,4    NOTGHST           BR IF NOT GHOST
         LB,1     J:RNST
         CI,1     1
         BNE      NOTGHST           NOT TRAP
         OVERLAY  MISOVSEG,T:GHOST#   TELL OPERATOR ABOUT GHOST TRAP
         BUMP     -19,3             REMOVE EXTRA ENVIRONMENT
         LW,3     USER
         STS,3    J:RNST            SET USER RUNNING TO GET DUMPS
         B        CKPMDOL           GO TO DEBUG
*
NOTGHST  CI,15    TIC
         BANZ      %+3
         CI,15    DELA
         BANZ     T:DEL
         LB,0     J:RNST
         BEZ      RUND
         CI,15    TIC               IF ITS A COMMAAD PROC IN
         BANZ     T:RUNDOWN         IN TROUBLE, RUN HIM DOWN
         CI,15    BAT
         BANZ     RUND
         CI,0     1
         BNE      T:ECCP            TO COMMAND PROCESSOR
         B        RUND
         PAGE
*
*        DEBUGGER EXIT LOGIC
*
*  GIVE DEBUGGER THE CONTROL
*
T:DEL    EQU      %
         BUMP     -19,2
         CI,15    DIC               IF THE DEBUGGER EXITED
         BANZ     XIT1              STRIP THE GUY
         LI,10    SPPBASE+X'E'      DELTA'S EXIT CONTROL ENTRY
         B        DELDEST           DELTAGO WITH SELF DESTRUCT.
*
         PAGE
*
*        USER REINITIALIZATION LOGIC
*
*
* STRIP A GUY DOWN
*
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
RUND1    STW,4    S:CRASHUN
         DISABLE
         LH,15    UH:FLG,4
RUND     RES      0
         OR,15    X4000
         STH,15   UH:FLG,4
         ENABLE
         CW,4     DID
         BNE      %+3
         LI,0     0
         STW,0    DID
         LD,0     19PSD
         STD,0    TSTACK
         CI,15    TIC
         BAZ      XIT1
* STRIP WITH TEL IN CONTROL
         BAL,2    DRTEL1
         LI,7     0
         LI,2     XIT2
         B        RPROCS
* STRIP WITHOUT TEL IN CONTROL
XIT1     LB,7     UB:ASP,4          OR ALL ASSOCIATED PROCESSORS
         BNEZ     %+2
         LB,7     UB:DB,4
         BAL,3    DRPROCS
XIT2     EQU      %
         DISABLE
         LRSETS   DELA
         RSETSST  DIC
         ENABLE
         LW,1     Y003E
         CI,15    BAT               CHECK FOR PMDS BEFORE
         BANZ     CHKPMD             ZAPPING RUN FLAGS
         LI,0     0
         STS,0    J:RNST            ZAP RUN FLAGS TO SHOW
         LC       J:JIT             MONITOR RUNNING
         BCS,4    CLOSEDCBS         SKIP THIS STUFF FOR GHOSTS
         LI,6     3
         STB,0    JB:PROMPT,6       RESET PROMPT CHAR
         INT,3    MUPO+J:JIT
         AI,3     0
         BEZ      CLOSEDCBS
*
*        PMDS
*
CHKPMD   EQU      %
         LB,4     J:RNST
         BNEZ     CKPMDOL
         LI,4     X'20000'
         CW,4     J:ASSIGN
         BANZ     CKPMDOL
         INT,5    MUPO+J:JIT
         AI,5     0
          BEZ     CHKPMD6
CKPMDOL  OVERLAY  DEBUGSEG,7
CHKPMD6  EQU      %
         LI,0     0
         LW,1     Y003E
         STS,0    J:RNST
*
* CLOSE ALL DCBS
*
CLOSEDCBS EQU     %
         REF      TQOV1SEG
         LW,6     J:ASSIGN          SEE WHETHER THIS GUY HAS
         CW,6     Y004              DONE ANY TP QUEUE CALLS.
         BAZ      CLS0              ---> NO. DON'T BOTHER TO PURGE.
         LW,8     Y006              GET Y006 TO STACK FOR Q TO FIND.
         PUSH     2,7
         LI,6     0
         LW,7     TSTACK            POINT R7 TO Y006 IN STACK.
         LI,8     X'B'
         OVERLAY  TQOV1SEG,0        Q PURGE
         LI,6     0
         LW,7     Y004
         STS,6    J:ASSIGN          CLEAR QUEUE-CALLS-DONE FLAG.
         PULL     2,7
CLS0     EQU      %
         BUMP     -19,6
         BAL,0    CLSDCBS           CLOSE ALL OPEN DCBS
         LI,6     3
         LW,4     S:CUN
         LH,15    UH:FLG,4
         CI,15    BAT
         BANZ     XIT51
         STB,6    M:UC,6
         LW,6     M:UC+COCLN
         AND,6    M8
         CI,6     LNOL-1            CHECK VALIDITY OF LINE
         BG       XIT51              BEFORE CLOBBERING TABLES
         LW,13    J:JIT
         CB,13    LB:UN,6           IS THIS THE RIGHT LINE?
         BNE      XIT51              NO.  DONT DO ANYTHING.
         DISABLE
         LB,13    MODE2,6
         AND,13   XFC
         STB,13   MODE2,6           RESET ACTIVAITION CHAR SET
         ENABLE
XIT51    LD,14    P:NAME,7          IS IT LINK EXITING
         CD,14    LINK
         BE       XITLINK           YES, GO SAVE LMN AND CONSIDER RUN.
         CW,14    7                 CHECK FOR DRSP LINKS
         BNE      %+3
         LW,7     15                IT WAS..  GET NEXT SLOT
         BNEZ     %-6
         PAGE
*
*
* STRIP THE USER DOWN TO HIS JIT AND COOP BUFFERS
*
*
*
XITNRUN  EQU      %
         LW,10    J:ICBHDR          ANY REAL-TIME CAL1'S ISSUED?
         BGEZ     XIT705            NO
         OVERLAY  RTNRRTSEG,RTRNDWN# RTNRRT MODULE
*
* RUN THRU LMAP TO RELEASE ALL USER PAGES EXCEPT SPARE BUFFERS
* THIS REMOVES: USER DATA/DCB/PROCEDURE/DD
*               SHARED PROC (STD OR SPEC) DATA/DCBS/DD
*
XIT705   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
*
* RELEASE SHARED PROCESSORS PROCEDURE PAGES
* RELEASE T:SAD PAGES
*
XIT720   LI,10    0
         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
*
* RESET JIT MEMORY LIMITS
*
         BAL,4    T:RSTLMS
*
* CLEAN UP LDLNK AND LDTRC
* I.E. CLOSE FILES AND RELEASE IDN * FILES
*
LDLNK    LI,8     X'FF'
         AND,8    J:RNST
         BEZ      XIT85
         OR,8     Y8                FLAG INDICATING EXIT TO LDLNK
         OVERLAY  LDLNKSEG
*
* RELEASE FILE MANAGEMENT BUFFERS
*
XIT85    BAL,6    T:ZBUF            RELEASE ALL FPOOLS
*
* RESET JIT VALUES
*
         LI,10    0                 RESET JIT
*BIT 0/1 RETAINED FROM JOB STEP TO JOB STEP
         LW,11    M31-1             SINCE M30 IS NOT DEFED
         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
         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
         STW,10   J:CLM+4           FOR DELTA
XIT730   EQU      %
         LI,11    X'FFF00'
         STS,10   JB:PCP
         LW,11    Y8
         STS,10   J:ASSIGN
*
* RESET USERS UPPER LIMIT MEMORY POINTERS
*
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
         LW,4     S:CUN
         LRSETSST TIC
         STW,10   RCVUSER
         STW,10   S:CRASHUN
*
* IF OUTSTANDING ENQUEUES, DO DEQ FOR STEP
*
         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
         SREF     ENQ
ENQPUL   BUMP     -4,1
NOENQ    EQU      %
         MTB,1    JB:STEP           COUNT UP JOB STEPS
         LW,4     S:CUN
         B        T:ECA             GET TEL
         PAGE
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
         LI,14    X'A504'           ERR CODE FOR EXTENDED USER ABORT
         SCS,14   -8
         LW,2     J:TELFLGS
         CW,2     Y002              ABORT EXTENDED USER
         BANZ     T:ABORTM
         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       T:ABORTM           PROC. IS BELOW ASP PROCEDURE
         SPACE    5
T:ECA    EQU      %
         BUMP     19,2
         BAL,2    DPROCS
         LD,6     SYSACT
         LW,2     TSTACK
         LCI      2
         STM,6    -2,2
         LB,5     UB:ACP,4
         BEZ      EC10X
         LCF      J:JIT
         BCR,8    TOASP             IF NOT ONLINE, GO TO COMMAND PROC
         LI,2     0
         LI,3     X'F0'
         STS,2    M:UC              CLEAR BTD FOR TEL
         LB,3     J:RNST
         CI,3     X'18'             OP ABORT/LINE HANGUP
         BANZ     EC10
TOASP    LRSETS   INIT,10
         OR,10    X4000
         STH,10   UH:FLG,4
         B        ASP1
*
*  IF ONLINE USER WITH A 2741 TERMINAL, SET THE DEFAULT PLATEN
*  WIDTH TO 132 COLUMNS.
*
EC10X    LC       J:JIT             CHECK FOR ONLINE
         BCR,8    EC10              B/NOT ONLINE
         LI,R6    X'FF'             L/MASK FOR LINE NUMBER
         AND,R6   M:UC+COCLN        G/LINE # FROM M:UC
         LC       MODE2,R6          CHECK FOR 2741
         BCR,1    EC10              B/NOT 2741 TERMINAL
         LI,R6    BA(JB:PCW)        L/BA OF PLATEN WIDTH IN JIT
         LI,R7    132               L/132; DEFAULT 2741 PLATEN WIDTH
         STB,R7   0,R6              S/PLATEN WIDTH
EC10     STB,2    J:RNST
         LD,6     LOGON
         B        T:ASP
         PAGE
*
*      MISC ROUTINES
*
DTORP    LH,15    UH:FLG,4          BALED TO ON 2
         CI,15    TIC
         BANZ     DTEL
         B        DPROCS
DRPROCS  BAL,2    DPROCS            DECRE/RESET PROCS
         LW,2     3
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
DRASP    BAL,2    DASP
         BAL,2    RASP
         B        0,3
         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
         REF      JB:PCDCB
         STH,3    JB:PCP            CLEAR PUPE P AND DATA CNT
         B        0,4
         PAGE
*
* SUBROUTINE TO  CLOSE DCBS
*
CLSDCBS  EQU      %
         LW,14    Y002
         CW,14    M:XX              IS M:XX OPEN
         BAZ      XXCLSD            NO
         LI,6     M:XX              YES-CLOSE IT
         BAL,11   CLOSE
XXCLSD   LI,14    0
         LI,6     22
         STW,14   M:XX-1,6
         BDR,6    %-1
         LI,6     MXFPL
         STW,6    M:XX+6
         LI,6     MXKB
         STW,6    M:XX+10
         XW,14    J:RNST            OMIT ABORTS
         LW,6     J:DCBLINK
         BEZ      CLSEXIT           NO DCBS
XIT3     AI,6     2                 POINT TO 2ND WORD OF ENTRY
         LW,13    -1,6              GET FIRST WORD
         LB,5     13                # OF BYTES IN NAME
         BNEZ     XIT35             NOT DONE YET
CLSEXIT  STW,14   J:RNST            RESTORE RNST
         B        *0                EXIT
*
*
XIT35    CW,13    TXTMD
         BNE      XIT33
         LB,13    *6
         AI,13    -'O'
XIT33    SLS,5    -2
         AW,6     5
         LW,1     0,6
         LW,15    0,1
         CW,15    Y002
         BAZ      XIT3
         AND,15   M4
         AI,15    -3
         BL       XIT4
         BNE      %+4               NOT A DEVICE
         REF      CNMLNDCB
         LW,15    CNMLNDCB          IS A DEVICE, SEE IF A SLAVE
         CS,15    0,1                 CNM LINE.
         BE       XIT4              --> YES. CLOSE IT.
         LI,2     X'FF'
         AND,2    1,1
*  RESET DIAG AND NO ERR FLGS
         LW,5     DCT9,2
         LC       5                 IS IT DIAG
         BCR,2    NDIAGIO
         AND,5    NB31TO0+30        DFFFFFFF
         STW,5    DCT9,2
         LB,5     DCT3,2
         AND,5    NB31TO0+3         FFFFFFFB
         STB,5    DCT3,2
NDIAGIO  EQU      %
         LB,5     DCT24,2
         AND,5    NB31TO0+7         TURN OFF DEV.DOWN FLAG
         STB,5    DCT24,2
         LI,2     X'FF00'
         AND,2    1,1
         AI,2     -X'8800'
         BLZ      XIT3
         AI,2     X'8800'-X'8A00'
         BGZ      XIT3
XIT4     LI,2     0
         STW,2    3,1               ZAP ERA
         STW,2    4,1                AND ABA
         PSW,6    TSTACK
         LW,6     1
         LI,2     CLOSE
         AI,13    0                 IS IT M:DO
         BNEZ     %+2               NOPE
         LI,2     CLOSESAVE         YEP,SAVE IT
         BAL,11   0,2
         PLW,6    TSTACK            ITS CLOSED
         B        XIT3              GO LOOK AT NEXT DCB
*
*
CLOSESAVE PUSH    16,5
         LI,5     SAVEFPT
         B        CLOSE1
CLOSE    PUSH     16,5
         LI,5     DOUBLEZERO
CLOSE1   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
*
* 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
         PULL     0
         B        *0
         PAGE
*
*        LOAD AND GO LOGIC
*
XITLINK  EQU      %
         LI,2     SPDBASE
         LCI      3
         LM,3     J:ACCN            SET ACCN FOR DELTA
         STM,3    J:CLM
         LM,3     16,2              SAVE LAST LOAD MODULE NAME
         STM,3    J:LMN
         STM,3    J:CLM+4           SET NAME FOR DELTA
         LW,3     15,2              PICK UP LINK RUN FLAG
         BNEZ     XITNRUN
         STW,3    J:USENT
         STW,3    J:CLM+2           ZAP PASSWORD
*
*  LINK SAID RUN
*
         LW,5     7
         BAL,0    SPCON             MOVE LINKS DATA TO SP BUFF 1
         LD,10    HBUF+12           CHECK FOR A 'RUN
         BEZ      NODELTA            ROM UNDER DELTA'
         CD,10    DELTA
         BNE      NODELTA
         LI,11    X'80'             SET THE 'UNDER DELTA'
         STS,11   J:TELFLGS          FLAG IN J:TELFLGS
NODELTA  EQU      %
*
* FETCH AND XITLINK LOGIC MERGE HERE
*
* ASSEMBLE UNSHARED PROGRAM LOGIC
*
XIT10    EQU      %
         LD,0     19PSD             SET SINGLE ENVIRONMENT
         STD,0    TSTACK
         LW,0     USER
         LW,1     Y003E
         LB,2     J:ASSIGN
         AND,2    X17
         STB,2    J:ASSIGN
         STS,0    J:RNST
         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
         REF PAGEZAPT,PAGEZAP0,GZPRIV,JB:PRIV
         BAL,5   PAGEZAPT     TOTAL CLEAN OF COMMON
*                                     CORE LIBRARY DATA AND BLANK COMMON
         BCS,15   OUTOFPGS2
*
*  SET ACCESS AND LIMITS
*
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
*
* ESTABLISH DYNAMIC DATA LOWER AND UPPER LIMITS
*  LIMITS DEPEND ON IF LOAD MODULED WAS LOADED OR LINKED
*
         LB,7     HBUF              GET KEY FROM HEAD RECORD
         CI,7     X'84'             WAS IT LINKED
         BNE      OLAYLIM           NO
*
* LOAD MODULE WAS LINKED
*
         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
         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
*
* LOAD MODULE WAS LOADED
*
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
         STW,7    J:DDLL
         STB,7    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
*
* SET UP DCBLINK IN JIT
*
XIT34    EQU      %
         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
*
* SET UP FOR DCB CHECKER
*
         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
         LH,2     HBUF+2            TCB OR 0
         AH,2     HBUF+2            WORD ADDRESS
         LW,2     10,2              DCB LINK
         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
*
* VERIFY AND INITIALIZE M:SEGLD
*
         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,2     7                 DID WE FIND ONE
         BNEZ     %+3               YES
         LI,10    0
         B        ABN2
         LW,3     KBUF,2            BUFFER ADDRESS
         AND,3    M17
         AI,3     -10-22            -SIZE OF DCB - 10 WORD VLP
         SW,3     2
         BGEZ     %+3
         LI,10    X'C'              NOT ENOUGH ROOM FOR VLP
         B        ABN2
         LCI      10
         LM,3     M:XX+22           MOVE VLP TO M:SGLD DCB
         STM,3    22,2
*
* MOVE INFO FROM HEAD RECORD TO JIT
*
XIT39    EQU      %
         LI,8     X'1FFFF'
         AND,8    HBUF+1            START ADDRESS FOR LOAD MODULE
         STW,8    J:START
         LH,10    HBUF+2            TCB DOUBLWE WORD ADDRESS
         AND,10   M16
         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
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 FOR DELTA
         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:JIT+JITREE
*
* SAVE CORE LIBRARY NAME AND DEBUGGER NAME
*
         LCI      2                 CORE LIBRARY NAME
         LM,14    HBUF+9
         LM,8     HBUF+12           DEBUGGER  NAME
*
* RELEASE STEPS DATA PAGE
*
         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
*
* DETERMINE IF DEBUGGER MAY BE ASSOCIATED
*
         LI,6     0                 SET FOR NO DEBUGGER
         LW,4     S:CUN
         LC       J:CFLGS           LINK/LDTRC IN PROGRESS
         BCS,12   XIT40             YES-DEBUGGER NOT ALLOWED
         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
*
* ASSOCIATE CORE LIBRARY IF NEEDED
*
XIT40    EQU      %
         AI,14    0                 IS CORE LIB TO BE ASSOCIATED
         BLEZ     XIT31             NO
         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
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
         LI,1     UB:ASP
         BAL,0    T:CHKSIZ          INSURE ENOUGH PCORE
         AI,6     0                 IS DEBUGGER ALSO NEEDED
         BNE      XIT12             ASSOCIATE AND ENTER IT
         DISABLE
         LRSETSST RTR
         ENABLE
         MTB,1    PB:UC,5
         LI,11    ASP14
         B        STEP101           TO T:REG E:AP
*
*  DONT NEED CORE LIBRARY-IS DEBUGGER NEEDED
*
XIT31    AI,6     0
         BNE      XIT12
         BAL,11   XIT31RT
         LI,5     0
         LW,9     J:PLL
         SLS,9    9
         LW,8     J:START
         B        ASP14
*
*  ASSOCIATE DEBUGGER
*
XIT12    EQU      %
         BUMP     19,1              EXTRA ENVIRONMENT FOR ASP
         LD,4     SYSACT
         LW,2     TSTACK
         LCI      2
         STM,4    -2,2              DEBUGGER IS IN :SYS
         B        T:ASP             NAME IS IN R6/R7
*
DELDEST  LI,11    DELTAGO           R10 IMPORTANT OTHER REGS
         DESTRUCT                    RESTORED BY SSS
SSEMDEST LI,11    T:SSEM
         DESTRUCT
         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    M8
         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    M16               AND BLK 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
*
*        INTERPRETIVE EXIT LOGIC
*
STEP00   EQU      %                 ***COMMAND PROCESSOR EXIT***
         CI,15    SJAC              RESET SJAC IF IT IS SET
         BAZ      STEP0010
         DISABLE
         LRSETST  SJAC
         ENABLE
STEP0010 LB,5     UB:ACP,4          GET COMMAND PROCESSOR #
         BAL,0    STEP002           CLEAR PROCEDURE OUT OF CMAP
         MTB,-1   PB:REP,5
         B        STEP02            JUMP OVER STEP SUBROUTINES
         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
*
*  EXITING FROM RUNNER
*
STEP003  EQU      %
         AND,15   XEFFF             RESET SJAC
         STH,15   UH:FLG,4
         BAL,3    DRASP             DISASSOCIATE RUNNER
         BUMP     -38,7
         BAL,0    SPCON             MOVE DATA AS FETCH REQUIRES
         STW,0    RNRKEY            SET SO FETCH WILL KNOW
         LW,4     USER
         LW,5     Y003E
         STS,4    J:RNST
         B        FCH451            LEAP INTO SECURITY CHECKS
         PAGE
*
* CHECK FOR LOGOFF OR CONTINUE
*
STEP02   EQU      %
         LW,5     TSTACK
         LW,6     -9,5
         BEZ      STEP10
*
* WE WANT A PROC OR USER.
*
*
* RELEASE PROCESSOR FPOOLS-DATA-DCBS
*
         LW,7     J:RNST
         AND,7    Y003E
         BNEZ     STEP04            USER/PROCESSOR RUNNING
         PUSH     9
         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:DCBLINK
*
*    RELEASE COMMAND PROCESSOR DYNAMIC PAGES
*
         LH,8     JB:BCP            GET JB:BCP
         AND,8    M8                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
*
         BAL,4    T:RSTLMS
STEP04   EQU      %
*
*    STORE CALLING COMMAND PROCESSOR IN STACK
*
         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.
         LW,4     S:CUN
*
*  IF AN ONLINE USER THAT IS BEING ASSOCIATED WITH LOGON, RESET
*  THE HALF-DUPLEX PAPER TAPE MODE.
*
         LC       J:JIT             CHECK FOR ONLINE
         BCR,8    STEP04C           B/NOT ONLINE
         CD,R6    LOGON             C/ACP BEING CALLED W/'LOGON'
         BNE      STEP04C           BNE
         LI,R2    X'FF'             L/MASK FOR LINE #
         AND,R2   M:UC+COCLN        G/LINE # FROM M:UC
         CI,R2    LNOL-1            C/LINE # WITH MAX LEGAL #
         BG       STEP04C           BG; ILLEGAL
         CB,R4    LB:UN,R2          C/CURRENT USER # W/USER # IN LB:UN
         BNE      STEP04C           BNE; M:UC LINE # IS INVALID
         DISABLE                    **DISABLE**
         LB,R15   MODE3,R2          L/MODE3
         AND,R15  NB31TO0+7         &/MODE3 W/.FFFFFFBF; RESET .40
         STB,R15  MODE3,R2          S/MODE3
         ENABLE                     **ENABLE**
STEP04C  EQU      %
         LH,15    UH:FLG,4
         CI,15    TIC               TEL/CCI IN CONTROL?
         BAZ      STEP05            YES, RESET IT
         LW,9     -9,5              SAVE 6 FOR FETCH
         BAL,2    DRTEL1            DECREMENT USE COUNT
         LB,1     UB:ACP,4
         LD,2     P:NAME,1          IS THIS LOG-ON INITIALIZING
         CD,2     LOGON              AN ON-LINE USER
         BE       STEP041
         CW,2     1                 CHECK FOR DRSP LINKS
         BNE      STEP06
         LW,1     3                 IT WAS.. GET NEXT SLOT
         BNEZ     %-6
         B        STEP06
STEP041  MTB,-1   PB:REP,1          YES-DECREMENT LOGON
         LI,1     PNAMEND            AND SWITCH TO TEL
         LD,2     TEL
         CD,2     P:NAME,1
         BE       STEP09
         BDR,1    %-2
STEP06   EQU      %
         CW,6     YFF               TEXTC NAME IN R6 MEANS
         BANZ     T:ASP              TEL PERFORMED THE EXIT
         LW,5     TSTACK            CCI PERFORMED THE EXIT
         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
         LW,9     6                 SAVE RUN TABLE ADDRESS FOR FETCH
         LCI      3
         LM,6     -9,5
         B        T:ASP
*
STEP09   MTB,1    PB:REP,1
         STB,1    UB:ACP,4
         STW,2    -11,5
         STW,3    -10,5
         B        STEP06
         PAGE
*
*        LOGOFF/CONTINUE LOGIC
*
*
STEP10   EQU      %
         LW,4     S:CUN
         LH,15    UH:FLG,4
         LB,5     UB:ACP,4          GET CMND PROC #
         LD,6     P:NAME,5          WAS IT LOGOFF
         CD,6     LOGON
         BE       T:DELUS           B IF YES
         CW,6     5                 CHECK FOR DRSP LINKS
         BNE      %+3
         LW,5     7                 IT WAS.. GET NEXT SLOT
         BNEZ     %-6
         BAL,2    DRTEL1
         LCF      J:JIT
         BCR,8    STEP20            IF NOT ONLINE, WIPE USER OUT
*
*        CONTINUE
*
         BUMP     -19,2
         DISABLE
         LRSETSST RTR
         ENABLE
         BAL,2    IPROCS
         BAL,11   T:PAC
         LW,4     S:CUN
         LH,2     UH:FLG2,4
         AND,2    XBFFF
         STH,2    UH:FLG2,4         RESET CP'S BRK CONTROL
         LB,6     J:EXTENT          *SEE IF THIS  SHOULD BE
         CI,6     X'02'             *  TAKEN AS A FAKE 'GO'
         BAZ      NOTFAKE           *  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
NOTFAKE  EQU      %
         LI,11    SSEMDEST
STEP101  LI,6     E:AP
         B        T:REG
*
         PAGE
T:SCRATCH%USER  EQU  %
         LW,15    S:CUN
         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
         LH,8     UH:FLG,5
         SLS,8    -1
         AND,8    X80
         OR,8     9
         STB,8    15
         STW,15   J:JIT
         LI,15    0
         LI,6     10
         B        STEP21
*
*        LOGOFF
*
T:DELUSZAP EQU    %
         LI,15    0
         B        STEP20+1
T:DELUS  EQU      %
         MTB,-1   PB:REP,5
STEP20   EQU      %
         LI,15    -1                INDICATES NORM LOG OFF
STEPENT  EQU      %
         LI,6     0
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
STEP22   EQU      %
         PUSH     6
*                     IF OUTSTANDING ENQUEUES, DO DEQ FOR JOB
         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
NOJENQ   EQU      %
         OVERLAY  MISOVSEG,T:DSMT#
*
*  RELEASE ANY READ-AHEAD ENTRIES FOR THIS USER
*
         SREF     RAB:FLINK,RA:ABNNN,RAB:USER,T:RAREL
         SREF     RA:DA
         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
         SPACE    2
*
STEP30   EQU      %                 RELEASE REMAINING PAGES
         PULL     6
         BDR,6    STEP40
STEP31   LB,7     JB:VLH
         BEZ      STEP40            DONE
         BAL,11   T:RVPI
         NOP
         B        STEP31
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
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
*                                   RELEASE JIT PAGE
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
*
         LW,4     S:CUN
         CW,4     OPNCLSUS
         BNE      STEP52
         LI,0     0
         BAL,11   T:UBLKOCU         DESTROYS 4 SAVES 5-10
STEP52   LW,4     S:CUN
*
         BAL,2    DTORP
         BAL,2    RPROCS
         LI,2     0
         LI,3     SCU
         STH,2    UH:JIT,5          JIT D. A.
         STH,2    UH:FLG2,5
         STH,2    UH:FLG,5          FLAG ITEMS
         STH,2    UH:WL,5           ******TEMP
         STB,2    UB:NECB,5         ******TEMP
         CI,8     ONLN
         BAZ      STEP70
         LI,6     LNOL-1            DON'T BELIEVE ANYONE'S
         CB,5     LB:UN,6           LINE NUMBER IN THE DCB
         BE       %+2               FIND HIS USER # IN
         BDR,6    %-2               LB:UN INSTEAD
         STB,2    LB:UN,6            INITIALIZE LINE-USER # TABLE
*
         B        STEP70
         PAGE
STEP05   BAL,3    DRPROCS
*
*        ASSOCIATE SHARED PROCESSOR LOGIC
*
T:ASP    EQU      %
         LW,4     S:CUN
         DISABLE
         LRSETS   INIT,10
         OR,10    X4000
         STH,10   UH:FLG,4
         ENABLE
*
* FIND THE NAME IN THE SHARED PROC TABLE
*
         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
ASP1     EQU      %
*
* GET BUFFERS FOR THE USER IF HE HAS NONE
*
         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
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       ASP24               RESET THE M:XX DCB
*
* VERIFY THAT ACCESS TO THE REQUESTED COMMAND PROCESSOR
* IS PERMITTED.
*
         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
         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
ASPNCP   LW,10    10                IS IT JOB STEP TIME
         BEZ      ASP235            YES
CHKDB    BUMP     -19,2
         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
ASP22    LW,1     P:SA,5            GET FLAGS FOR NEW SHARED PROCESSOR
         LC       1
         BCR,2    TELLA0            NOT A DEBUGGER
CHKDB1   LW,7     J:EUP             SEE IF THERE IS ROOM FOR A DEBUGGER
         LI,10    NOROOMSS
         CI,7     JEUPVP
         BNE      OUTOFPGS+1        NO ROOM
         AI,7     1                 YES-MAKE SURE WE CAN GET THE PAGE
         BAL,11   T:RVPI
         NOP
*
* SET UP M:XX IF AT JOB STEP TIME
*
ASP235   LW,3     M:XX              IS M:XX OPEN
         CW,3     Y002
         BAZ      ASP236            NO
         LI,6     M:XX              YES-CLOSE IT
         BAL,11   CLOSE
         PAGE
ASP236   EQU      %
*
*   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
*
*
XOS      EQU      2                 BIT 6 IN J:ASSIGN
RP       EQU      1                 BIT 7 OF J:ASSIGN
         LB,R1    JB:PRIV           GET USERS PRIV
         CI,R1    X'C0'             IS HE ABOVE ALL THIS SECURITY
         BGE      NOCHECK           B/ YES, SKIP THIS CODE
         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
         CI,R1    RP                :SYS IS OK, ALSO RP CHECK ?
         BAZ      NOCHECK           B/ NO, HE'S OK TO GO
RPLIST   EQU      %
         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
         STS,R2   M:XX+29
         LI,R2    RPERR1            ERR/ABN ADDRESS FOR READS
         LI,R3    X'1FFFF'
         STS,R2   M:XX+3
         LI,R0    X'20000'
         LI,R1    X'60000'
         STS,R0   M:XX+1            INPUT MODE
RPOPEN   EQU      %
         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
         LI,R6    M:XX              DCB ADDRESS
         LI,R7    DOUBLEZERO+1      FPT ADDRESS
         LI,R8    X'14'             OPEN CODE
         OVERLAY  OPNSEG,0          OPEN FILE
         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             ADDRES FOR READ BUFFER
         LI,R6    512*4             MAX SIZE OF RECORD IN BYTES
         BAL,R11  READ              GO READ RECORD
         LI,R6    M:XX
         BAL,R11  CLOSESAVE         CLOSE RPL FILE
*
*   SEARCH RECORD FOR REQUESTED PROCESSOR
*
         LH,R0    RPBUF             PICK UP COUNT AND FLAG
         AND,R0   M15               GET RID OF FLAG AND SIGN BITS
         LI,R1    RPBUF+RPBUF+RPBUF+RPBUF+4  BYTE ADDRESS OF FIRST ENTRY
         LW,R2    TSTACK
         LCI      3
         LM,R9    -9,2              PROCESSOR NAME
         LM,R12   -2,2              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 COUN
         AI,R1    1
         LW,R15   R1                ADDRESS FOR CBS
         AW,R1    R7                BUMP R1 PAST NAME
         LI,R14   R9*4+1            SOURCE ADDRESS FOR MBS, 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
         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
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
         SCS,R8   -1                PUT BIT INTO B0 POSITION
         LW,R1    RPBUF             GET MODE BITS
         AND,R1   Y8                CLEAR OUT ANYTHING ELSE
         EOR,R1   R8                COMPARE, MODE BIT MUST MATCH
         BEZ      RPABORT           B/ THEY DON'T MATCH
RPOK     EQU      %
         LI,R5    0
         LI,R14   RPBUF             ADDRESS OF BUFFER
         BAL,R2   T:RBUF
*
NOCHECK  EQU      %                 COME HERE TO SKIP ALL RP AND XOS CHECKS
         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
*
* GO TO FETCH IF NOT A SHARED PROCESSOR
*
ASP24    CI,5     MAXOVLY
         BL       FETCH             IT'S NOT IN THE TABLE
         LB,8     PB:PSZ,5
         BEZ      FETCH             IT'S SIZE IS 0
         LC       J:CFLGS
         BCR,X'C' %+3               EXTRA ENVIRON NO LONGER NEEDED
*                                   FOR LDLNK TO PROCESSOR
         BUMP     -19,8
*
* CHECK FOR SPECIAL JIT ACCESS
*
         LW,8     P:SA,5
         LCF      8
         BCR,8    ASP271
         DISABLE
         LSETRST  SJAC,10
         ENABLE
*
* CHECK TO MAKE SURE IT IS VALID TO ASSOCIATE PROCESSOR
*
ASP271   EQU      %
         LW,2     Y002              FOR EXTENDED USER CHECKS
         LI,12    JEUPVP            FOR LIMIT CHECKS
         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
         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.
*
* ASSOCIATING STANDARD SHARED PROCESSOR
*
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
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
*
* SET UP JIT POINTERS FOR STANDARD SHARED PROCESSOR
*
         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
*
* SET AC FOR DATA, DCBS AND PROCEDURE
*
         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
         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
         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
         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
*
* SET UP J:RNST
*
ASP36    EQU      %
         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      %
         LW,4     S:CUN
         LH,10    UH:FLG,4          ACCUMULATE FLAGS IN R10
*
* GET DCB AND  INITIAL DATA PAGES IF REQUIRED
*
         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
         BCS,15   OUTOFPGS
*
* SET UP ACP/APR/ASP/DB AND THEN REG TO GET PROCESSOR
*
ASP8     EQU      %
         LW,4     S:CUN
         CW,8     Y07               IS IT A COMMAND PROC
         BAZ      ASP9              B IF NO
         MTW,0    J:ACCN            IF NO ACCOUNT IN JIT
         BEZ      %+3                WE ARE EXITING LOGON
         LB,2     UB:ACP,4          DECREMENT LOGON PB:REP
         MTB,-1   PB:REP,2           PRIOR TO RESETTING UB:ACP
         LI,1     UB:ACP
         BAL,0    T:CHKSIZ          INSURE ENOUGH PCORE
         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
         SETR     DIC,10
         SETRST   DELA,10
         B        ASP11
ASP18    EQU      %
         LI,1     UB:ASP
         BAL,0    T:CHKSIZ          INSURE ENOUGH PCORE
         B        ASP11
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
ASP11    BAL,2    IPROCS            COUNT 'EM UP
ASP12    EQU      %
         RSETSST  RTR,10
         LI,6     E:AP
         BAL,11   T:REG             GET 'EM
         BAL,11   T:PAC             SET UP ACCESS IN CASE IT'S DELTA.
*
* LINK UP DCBS TO JIT IF NECESSARY
*
         LB,9     PB:PVA,5
         SLS,9    9
         LW,10    P:TCB,5
         LW,8     P:SA,5
         LW,4     S:CUN
         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
ASP131   EQU      %
         LD,2     SMPSD
         B        ASP14+1           TO SET START ADDR AND ASSIGN/MERGE
*
* FETCH AND LINK AND GO JOIN UP HERE
*
ASP14    LD,2     SMFPSD            START TO PSD, (MAPPED,SLAVE)
         LC       J:CFLGS
         BCS,8    ASP142
         LCF      8
         BCR,2    ASP1414           IF NOT A DEBUGGER,
         LH,15    UH:FLG,4           IT CAN'T BE DELTA.
         LW,10    8                 SET UP R10,R15 FOR DELTA
         LW,7     TSTACK
         AI,7     -17               SET UP USER ENVIR.
         LW,6     J:CLM+4           WILL BE NON-ZERO
         BEZ      %+5                AFTER A FETCH.
         LI,6     X'80'             IF THIS IS A
         CW,6     J:TELFLGS          'START UNDER', J:START
         BAZ      ASP15             ELSE DELTAS START ADDRESS
         OR,2     J:START           GET THE START ADDRESS
         STD,2    *7                IN THE ENVIRONMENT.
         LCF      J:ASSIGN          IF ASSIGNS HAVENT BEEN MERGED
         BCR,8    ASP175             GO MERGE THEM
ASP15    LI,1     0                 ELSE, GO TO DELTA
         B        KRD2
ASP1414  BCR,1    %+2               IF IT'S A LIBRARY,
         OR,2     J:START            MERGE IN START ADDR.
         AND,8    FF7FFFFF          ZAP CORELIB BIT IF ANY
         AW,2     8
         LW,6     TSTACK
         AI,6     -17
         STD,2    *6
ASP142   RES      0
         BAL,11   T:PAC             LOAD ACCESS
         LCF      8                 IF USER/ORDINARY PROC SET UP TCB
         BCR,4    ASP16
         LW,1     S:CUN
         LH,1     UH:FLG,1
         CI,1     TIC
         BAZ      %+3
         CI,1     BAT
         BAZ      ASM167
         LCF      J:ASSIGN          HAVE ASSIGNS BEEN MERGED
         BCS,8    ASM167            YES
         B        ASP17             NO, DO IT - DON'T DESTROY TCB
ASP16    EQU      %
*
* SET UP JIT
*
         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
         STW,9    JITREE+J:JIT
         BCS,12   ASP17             DONT DESTROY R8 IF LNKTRC
         LI,9     0
         STW,9    -7,1
*
*        ASSIGN MERGE
*
ASP17    EQU      %
         LC       J:CFLGS
         BCS,8    ASM167            IF RESTORING PROC FOR LDTRC ASSIGNS
*                                   BEEN DONE
*        SET CLOSE BIT TO GUAR SECURITY CHECKS UPON OPEN
ASP175   RES      0
         LW,9     Y006              MASK FOR CLOSE BITS
         LI,8     0
         LW,1     J:DCBLINK
         BEZ      ASM167
ASM2     EQU      %
*        GET TO DCB & SET BITS
         AI,1     2
         LW,6     -1,1
         LB,3     6
         BEZ      ASM3              NO MORE OR NONE(6=1)
         SLS,3    -2
         CW,6     TXTMGO
         BNE      ASM26
         LB,7     *1
         AI,7     -'O'
         BNE      ASM26
*        SET DEFAULTS INTO M:GO
         AW,1     3
         LW,2     0,1
         LI,12    1
         LI,13    X'F'
         STS,12   0,2               FILE TO ASN
         LI,12    X'40000'
         LW,13    Y00FF
         STS,12   1,2               OUTTO FUN
         STS,8    0,2               CLOSE BITS
         LW,2     6,2
         LI,5     2
         LI,12    1
         STB,12   *2,5              NAME IS 1 WD
         LI,12    X'FFFF'
         AND,12   J:JIT
         SLS,12   8
         OR,12    Y03
         AI,12    'G'
         STW,12   1,2
         LI,5     X'FF'
         AND,5    0,2
         SLS,5    2
         AI,5     6
         STB,13   *2,5
         B        ASM2
ASM26    EQU      %
         AW,1     3
         LW,2     0,1
         STS,8    0,2
         B        ASM2
ASM3     EQU      %
         LW,8     J:AMR
         BEZ      ASM167            NO ASSIGN/MERGE RECORD
         LB,8     J:ASSIGN
         AND,8    M5
         OR,8     X80
         STB,8    J:ASSIGN
*        READ ASSIGN FILE IF NOT IN CORE
         LW,8     J:ABUF
         BNEZ     ASM0              ASSIGN FILE IS IN
         LI,14    SBUF2VPA          GET SPECIAL BUF 2 FOR
         STW,14   J:ABUF              FOR ASSIGN MERGE RECORD
         BAL,2    T:GBUF
         LI,6     M:XX
         LW,8     M:XX
         CW,8     Y002
         BAZ      %+2
         BAL,11   CLOSESAVE
         LI,13    X'1FFFF'
         LI,12    SBUF2VPA          BUFFER ADDRESS
         STS,12   M:XX+BUF
         LI,12    2048              BYTE COUNT
         SLD,12   17
         STS,12   M:XX+BLK
         LI,6     M:XX              DCB ADDRESS
         LI,8     X'2D'             FPT CODE
         LI,10    0
         LI,11    ASM38             RETURN ADDRESS
         REMEMBER
         OR,11    Y8                SET STEP FLAG
         BAL,1    PUSHALL
         B        T:AMRDWT
ASM38    EQU      %
         AI,10    0
         BNEZ     ERRAMR            ERROR ENCOUNTERED
ASM0     EQU      %
         LW,13    M17
         LW,7     J:ABUF
         AI,7     1
         LW,2  7
ASM4     EQU      %
*        GO THRU  ASS SET (EACH HAS LINK TO NXT, TEXTC NAME & PLIST)
         LW,6     0,7               PTR TO NXT ASS SET (LINK ADR)
        BEZ      ASP165            DONE
         AW,6  J:ABUF
         LW,7     6
         AI,6     1
         LB,10    *6                COUNT OF NAME
         LI,1     J:DCBLINK
ASM5     EQU      %
         LW,1     0,1               BEG OF DCBTAB
         BEZ      ASM4              ASS MRG DCB NOT IN TABLE-CONT TO NXT
ASM6     EQU      %
*        COMPARE  ASS NAME WITH DCBTAB ENTRY
         AI,1     1
         LB,5     *1                COUNT OF NAME IN DCBTAB
         BEZ      ASM5
         CW,10    5                 ARE CNTS =
         BNE      ASM7              NXT DCB
         LB,11    *6,5              ASS NAME
         CB,11    *1,5              DCBTAB NAME
         BNE      ASM7              NXT DCB
         BDR,5    %-3
         B        ASM8              FOUND DCB
ASM7     EQU      %
*        GET TO NXT DCB IN DCBTAB
         LB,11    *1
         SLS,11   -2
         AW,1     11                POINTS TO END OF DCBTAB NAME ENTRY
        AI,1     1
         B        ASM6
ASM8     EQU      %
*        PUT DCB ADR INTO PLIST IN ASS MERGE SET
         LB,5     *1
         SLS,5    -2
         AI,5     1
         LW,12    *1,5              GET DCB ADR
         AW,6     5
         STS,12   0,6               INTO FPT IN ASS MRG SET
         LCI      0
         PSM,5    TSTACK
         LI,5     J:JIT
         LW,7     6
         LW,6     12
         LB,8     *7
         AI,7     1
         LI,10    0
         OVERLAY  OPNSEG,0
         LCI      0
         PLM,5    TSTACK
         B        ASM4
ASP165  EQU      %
         LW,7  2
         BEZ   ASM167
         AI,7  1
         LI,2  0
         B     ASM4
ASM167   EQU   %
         LW,1     S:CUN
         LC       J:JIT             ONLINE OR GHOST
         BCS,12   KRD1              YES-NO SSSL
         LI,2     12
         LW,0     J:JIT+SS
         LI,1     X'FF'
         STS,0    *J:TCB,2          TRANSFER SWITCH BITS TO TCB
*
*  SET XSL IN TCB.  XSL IS SPECIFIED ON THE RUN COMMAND AND IS
*  USED BY THE LIBRARIES IN DECIDING WHETHER OR NOT TO ABORT
*  BECAUSE OF RUN-TIME ERRORS.
*
         LI,2     14                L/WD TO XSL IN TCB
         LI,1     X'F00'            L/MASK FOR XSL IN JIT
         AND,1    J:RNST            G/XSL FROM JIT
         SLS,1    -8                SHIFT; RIGHT JUSTIFY
         STW,1    *J:TCB,2          S/XSL INTO TCB OR R14 IF NO TCB
KRD1     EQU      %
*       RELINK BUF TO FPOOL
         LI,1     0
         STH,1    J:CFLGS
KRD2     XW,1     J:ABUF
         BEZ      TOSSEM
         LI,14    SBUF2VPA          RELEASE ASSIGN/MERGE BUFFER
         LI,5     0                 VIRTUAL/PHYSICAL AND SWAP GRAN
         BAL,2    T:RBUF
TOSSEM   LW,4     S:CUN             *=*=*
         DISABLE
         LH,15    UH:FLG,4
         AND,15   XBFFF
         STH,15   UH:FLG,4
         ENABLE
         CI,15    TIC
         BANZ     SSEMDEST
         CI,15    DIC
         BAZ      SSEMDEST
         LB,1     UB:DB,4
         LW,10    P:SA,1
         B        DELDEST
         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
T:CHKSIZ PUSH     2,0               SAVE RETURN AND SH. PROC. TYPE
         PUSH     7
         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    *0                 PROCESSOR FOR LNKTRC
         MTB,1    PB:REP,5
         B        *0
*
*
ASPABORT PULL     7
         PULL     2,0
         LI,5     0                 RESET PROCESSOR THAT WASNT ASSOC.
         STB,5    *1,4
         LI,10    NOROOM2
         B        OUTOFPGS+1
         PAGE
TELLA2   LI,1     X'A2'             NO ACCESS TO COMMAND PROCESSOR
         B        TELLTEL
TELLA0   LI,1     X'A0'             INVALID DEBUGGER NAME
         B        TELLTEL
*
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
         LW,14    J:ABC
         BAL,2    IPROCS
         LC       J:JIT
         BCS,8    T:ECCP            TO COMMAND PROCESSOR
         LB,14    J:ABC
         LW,15    JIT+ERO
         STB,15   14
         B        T:ABORTM
         PAGE
*
*        ASSOCIATE UNSHARED PROGRAM LOGIC
*
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
*
* SET UP M:XX
*
FETCH    EQU      %
         LI,2     ERRTN             ERR/ABN
         LI,3     X'1FFFF'
         STS,2    M:XX+3
         STS,2    M:XX+4
         MTW,0    J:JIT             IF ONLINE SET CLM FOR DELTA
         BGEZ     %+5
         LCI      3
         STM,6    J:CLM+4
         STM,12   J:CLM
         STW,15   J:CLM+3
         LI,0     X'20000'
         LI,1     X'60000'
         STS,0    M:XX+1            INPUT MODE
         LI,1     1
         STW,1    M:XX              FILE
*
* OPEN THE FILE AND CHECK FOR EXECUTE ONLY
*
         LW,1     Y8                SET FLAG SO OPEN WILL KNOW
         STS,1    J:STAR             THIS IS FETCH OPENING THE FILE
         LI,6     M:XX              DCB
         LI,7     DOUBLEZERO+1      FPT ADDRESS
         LI,8     X'14'             OPEN CODE
         OVERLAY  OPNSEG,0
         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      %+3               NO
         LW,1     EXLYMSK           YES-SET FLAG IN JIT
         STS,1    J:EXLY
*
*  IS THIS BATCH & ARE THERE DEBUGS & MODIFIES - IF SO SET FOR RUNNER
*
         LW,4     S:CUN
         LH,15    UH:FLG,4
         CI,15    BAT|TIC
         BAZ      FCH4              NO RUNNER
         CW,9     YFF               RUN
         BANZ     FCH4               TABLE?
         LC       J:CFLGS
         BCS,4    FCH4              NO RUN TABLE IF LDLNK
         LW,7     J:EUP
         LI,1     X'20000'
         CW,1     J:ASSIGN          PMD'S
         BANZ     FCH2              YES
         LW,11    *9
         CW,11    XFFFF00           DEBUGS OR MODIFIES
         BANZ     FCH2
         LI,6     X'28'
         LB,11    *9,6              SYMB START
         BEZ      FCH3              NO
*
*  RELEASE CONTEXT   SET REGS FOR RUNNER & GO TO ASP
*  PUSH INTO STACK , ADR OF RUN TABLE IN EUP PG
*
FCH2     LW,0     EXLYMSK
         CW,0     J:EXLY            IS THIS EXECUTE ONLY LMN
         BAZ      FCH25             NO
         LI,0     0
         STS,0    J:ASSIGN          YES-ZAP REQUEST FOR PMD
         B        DBERR
FCH25    PUSH     4,9
         AI,7     1
         BAL,11   T:RVPI
         NOP
         LW,13    SYSACT
         LW,14    SYSACT+1
         LD,6     NRUNNER
         PUSH     16,0              SET UP ENVIRONMENT
         B        T:ASP             GO GET RUNNER
*
* RELEASE CCI RUN TABLE PAGE
*
FCH3     EQU      %
         LI,6     1
         STB,7    JB:BCP,6
         BAL,11   T:RVPI
         NOP
*
* GET SPECIAL BUFFER 1 FOR HEAD AND TREE
*
FCH4     LI,14    SBUF1VPA
         BAL,2    T:GBUF
         LI,7     SBUF1VPA
         LW,2     TSTACK            SET TEL'S "UNDER" NAME INTO HEADER
         LCI      2
         LM,10    -15,2
         STM,10   12,7
         LI,14    0                 SET KEY SO WE KNOW RUNNER
         STW,14   RNRKEY               WASNT ASSOCIATED
*
*        READ HEAD
*
         LI,6     12*4
         LW,0     TSTACK
         LW,4     TSTACK
         BUMP     2,1
         LCI      2
         LM,1     HEAD
         STM,1    1,4
         AI,0     1
         LW,4     USER
         LW,5     Y003E             SET USER RUNNING
         STS,4    J:RNST             SO WE GET MAX CORE CHECKS
         LW,1     Y4
         STS,1    J:ASSIGN
         BAL,11   READ
         BUMP     -2,1
         PAGE
*
*        STEP LOAD MODULE SECURITY CHECKS OF THE HEAD RECORD
*                 1. THE FIRST WORD MUST BE REASONABLE
*                 2. BIAS,PP, AND DCBS ON PAGE BOUNDRYS
*                 3. HEAD MUST BE OF THE PROPER SIZE
*                 4. IF LINK-LMN+RUNNER, ERROR
*
         LI,1     SMALLHEAD
         LW,6     M:XX+13
         CI,6     X'30'
         BNE      FETCH3            HEAD NOT CORRECT SIZE
FCH451   EQU      %                 CHECK AFTER RUNNER ENTRY
         LI,1     BADHEAD
         LI,6     LMKEY
         XW,6     HBUF
         CW,6     HEADMASK          FIRST WD REASONABLE
         BANZ     FETCH3            NO
         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
         LI,1     BADBIAS
         LW,6     2+HBUF            BIAS
         CI,6     X'FF'
         BANZ     FETCH3
         LI,1     BADPP
         OR,6     4+HBUF
         CI,6     X'FF'
         BANZ     FETCH3
         LI,1     BADDCBLOC
         OR,6     6+HBUF            DCBS
         CI,6     X'FF'
         BANZ     FETCH3
         LI,1     NOTKEYED
         LI,7     X'30'
         AND,7    M:XX+5
         CI,7     X'20'
         BNE      FETCH3
*
*  MAKE SURE PROCEDURE DOESNT OVERLAP CURRENTLY ALLOCATED COMMON PAGES
*
         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    M8                PAGE # OF PROCEDURE UPPER LIMIT
         LI,7     1
         CB,6     JB:BCP,7            : BOTTOM COMMON PAGE
         BG       OUTOFPGS2+1       IF OVERLAP ABORT USER
*
* DETERMINE IF USER MAY USE ALL OF VIRTUAL CORE
*
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
FCH51    LI,0     0                 YES-DELETE DEBUGGER REQUEST
         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
         LC       J:CFLGS           LDTRC IN PROGRESS
         BCS,4    FETCH7            YES-DONT CHANGE CORE ALLOCATION
         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
         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
*
* GIVE USER ALL OF CORE
*
         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
*
* LOAD MODULE WAS BUILT BY LINK
*
FCH453   LI,10    LDLKLINK          M:LINK/M:LDTRC TO LINKED LMN
         LC       J:CFLGS           IS LINK/LDTRC IN PROGRESS
         BCS,4    ABN1              YES
         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
*                                    FORCED TO NON-EXTENDED MEMORY MODE
*
* CORE LIBRARY OR DEBUGGER NEEDED
* MAKE SURE CORE HAS BEEN ALLOCATED WITH SPECIAL PROC AREA HELD BACK
*
FCH6     EQU      %
         LC       J:JIT             IS THIS AN ON-LINE USER
         BCR,8    FCH61             NO
         LW,1     Y002
         CW,1     J:TELFLGS         DOES HE WANT EXTENDED CORE
         BANZ     FCH62
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
*
* READ TREE
*
         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
         LI,1     SMALLTREE
         CW,6     M:XX+13
         BG       FETCH3
         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
*
* READ 00,01 AND DCBS TO APPROPRIATE AREAS
*
         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
         LI,6     M:XX
         BAL,11   CLOSE
         LC       J:CFLGS
         BCS,4    %+3               IF LD;LINK WE HAD TWO ENVIRONMENTS
*                                   COMING IN.
         BUMP     19,0
         B        FCH7              JUMP OVER THE DCB CHECKER FOR NOW
*                                    IT WILL BE CALLED LATER IN THE
*                                    ASSEMBLE UNSHARED PROGRAM LOGIC-XIT10
         PAGE
*        DCB CHECKER
*        INPUT:
*        DCBCHK IS ENTERED FROM STEPOVR AS A
*             BAL,11 DCBCHK
*        FROM OTHER MODULES ENTRY IS
*             PUSH 0
*             PUSH 2
*             OVERLAY STEPOVRSEG,DCBCHK#
*        ENTRY AT DRIVER PULLS REGS AND SAVES 11
*             THEN BALS INTO DCBCHK
*        UPON EXIT R11 IS RESTORED
*             AND A DESTRUCT IS PERFORMED
*
*                 0 = BUFFER ADDR OF DCBS RECORD
*                 1 = SIZE OF RECORD IN WORDS
*                 2 = BUFFER ADDR OF DCB CHAIN
*                 4 = ADDR OF CLOBBERABLE PAGE BNDRY PAGE BUFFER
*                 5 = -1  NO DCB INITIALIZATION
*                   =  0  FULL INITIALIZATION
*                   =  1  SPECIAL INIT FOR TEL GET
*
*        DCBS NEED NOT BE AT J:DCBLL
*        BUT MUST BE LOADED TO RUN THERE
*        OUTPUT:
*        BAD:  R6 = ERROR CODE
*        GOOD: R6 = 0
*        IF M:SGLD IS ENCOUNTERED, ITS ADDR IS RETURNED IN 3
         DEF      DCBCHK
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     0,2               END OF CHAIN
         SW,3     15                CONVERT TO BUFFER ADDR
         CLM,3    0                 MUST BE IN DCB AREA
         BCS,6    %+3
         LI,3     X'F1'
         B        DCBXBAD
         MTW,0    0,3               CAN THIS REALLY BE THE END?
         BEZ      %+3
         LI,3     X'F2'
         B        DCBXBAD
         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
         LB,6     *2
         BNEZ     %+3
         LI,3     X'F4'
         B        DCBXBAD
         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
         SW,6     15                CONVERT TO BUFFER ADDR
         CLM,6    0                 IS THIS LIGGLE
         BCS,6    %+3
         LI,3     X'F6'
         B        DCBXBAD
         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
         AI,2     -1
         SLD,2    -9
         SLD,6    -9
         CW,2     6                 DCB MAY NOT
         B        %+3               TEMPORARY - SKIP PAGE BOUND
         LI,3     X'F7'
         B        DCBXBAD
         SLD,2    9
         SLD,6    9
         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
         AI,6     1
         LW,5     5                 CHECK INIT FLAG
         BLZ      NOINIT            NO INITIALIZATION
         BGZ      TELINIT           SPECIAL INIT FOR TEL GET
         LI,2     0                 INITIALIZE
         LW,3     Y006                 AND
         STS,2    FCD-22,6              FCD, FCI TO ZERO.
         B        NOINIT
*
TELINIT  EQU      %
         LW,1     Y002
         CW,1     FCD-22,6
         BAZ      NOINIT            CLOSED - DO NOTHING
         LW,1     Y006              OPEN - RESET FCD,
         LW,0     Y004                SET FCI
         STS,0    FCD-22,6
*
NOINIT   EQU      %
         LW,0     KBUF-22,6
         LW,1     FLP-22,6
         AND,0    M17
         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
         AI,0     -8
         STW,0    7                 KBUF NOW END OF LIMITS
CHKFLP   AND,1    M17
         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
DCB3     EQU      %
         LW,3     0,1               GET FLP KEY WORD
         LH,2     3                 SAVE BYTE 1
         AND,3    M8                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'
         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
         PAGE
*
*        CONTINUATION OF ASSOCIATE UNSHARED PROGRAM LOGIC
*
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
*
*        FILL IN WD 10 OF TREE TABLE - ALL SEGMENTS
*
         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
         BEZ      FET14
         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
*  DEBUG CAL, SO GO THRU FPT CHAIN IN DB TBL & SET REPLACED INST
         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    M17
         BNEZ     FET10             NO
         B        FET12
FET11    EQU      %
*  NOT DB CAL SO SET VALUE INTO LOC
         STW,0    *9                SET VAL IN LOC
FET12    EQU      %
         AI,5     2
         BDR,6    FET9              ARE THERE ANY MORE ENTRIES IN CLOB
FET14    EQU      %                 NO
         B        XIT10
         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    M8
         AND,6    M8
         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    M17
         AND,6    M16
         SLS,6    3                 TO BYTES
         LW,1     Y4
         LW,0     HBUF              GET KEY ADDR AND 85 FLAG
         BGZ      FETCH6            NOT 85TYPE
         AND,0    M17               STRIP THE INDIRECT
         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
*
*
* CORE ALLOCATION ERRORS   A5-XX
*
* ENTRY FROM LDEV WHEN CPOOL IS NOT AVAILABLE
NOCPPGS  LI,10    X'09'             GEN A509 ERROR
         B        OUTOFPGS+1
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
*
* SNAP/MODIFY NOT ALLOWED WITH EXECUTE ONLY LOAD MODULE
*
DBERR    LI,10    X'51'
         LI,1     X'A6'
         B        ABN11
*
* LOAD MODULE TYPE ERRORS   A6-XX
*
FETCH3   LW,10    1
         B        ABN1
*
* DCBCHECKER DETECTED ERRORS   B6-XX
*
BADDCBS  LW,10    6
         AND,10   M4
ABN2     LI,1     X'B6'
         B        ABN1+1
*
* ERROR OPENING LOAD MODULE
*
OPNERR   LI,1     X'A6'
         LB,10    10
         B        ABN11
*
* ERROR READING LOAD MODULE
*
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
         LW,3     M:XX
         LI,6     M:XX
         CW,3     Y002
         BAZ      %+2
         BAL,11   CLOSE
         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
         LI,4     0                 SET MONITOR RUNNING
         LW,5     Y003E              SO HE GETS ABORTED BY
         STS,4    J:RNST              BY MONITOR MESSAGE
         LC       J:CFLGS
         BCR,12   TELLTEL           NOT LDLNK
         LI,1     0
         STH,1    J:CFLGS
         LI,1     X'B5'
         B        TELLTEL
*
* ERROR READING ASSIGN/MERGE RECORD
*
ERRAMR   EQU      %
         LW,1     S:CUN
         LH,1     UH:FLG,1          IS TIC SET
         CI,1     TIC
         BANZ     ASM167            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
         LW,11    Y003E
         STS,10   J:RNST            SET MONITOR RUNNING...
         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
         REF      CHKDA
         REF      GBG
         REF      IOSPIN
         REF      MSR01EXIT
         REF      PULLALLEXIT
         REF      QUEUE
         REF      T:IACU
SR3      EQU      10
SR4      EQU      11
T:AMRDWT EQU      %
         LW,13    8                 SAVE FUNCTION
         LI,1     X'1FFFF'
         LS,0     2,6               GET USERS BUFFER ADR
         STS,0    7,6               STORE AS MONITOR BUFFER ADR
*
         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
         BAL,11   BUFCHK            VALIDATE THE BYTE COUNT
*
         LW,8     M24
         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
         DESTRUCT MSR01EXIT
*
SET02    EQU      %
         PUSH     13
         LI,0     X'70B'            PACK THEN RAD
         BAL,11   GBG               GET A BACKGROUND GRANULE
         PULL     13
         AI,8     0
         BNEZ     SET05             GOT THE GRANULE
         LI,10    X'57'             NO GRANULE AVAILABLE
         DESTRUCT MSR01EXIT
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
         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
         LW,7     BLK,6
         AI,7     X'60000'          ROUND UP USER'S BYTE COUNT
         SLS,7    -19               # WORDS TO READ
         AI,7     -1
         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
WRTCHK   EQU      %
         BAL,11   FLAGCHK           CHECK FOR TIC OR MASTER MODE
         B        NOWRITE
         LI,10    X'26'             OK, SET WRITE CODE
SET20    EQU      %
*                 R8 FOR QUEUE1 CALLING SEQUENCE
*
         LW,8     6                 VIRTUAL DCB ADR
         STB,10   8                 READ/WRITE CODE
         LW,SR4   BTYC
         STS,SR3  TYC,6             RESET TYC
*
         LI,1     BAFCN             INCR FUNCTION COUNT
         MTB,1    *6,1
         BAL,11   QUEUE
         BAL,SR4  IOSPIN
         LC       J:JIT             L/FLAGS FROM WD 0 OF JIT
         BCS,4    SET30             B/GHOST JOB; DON'T CHK AM REC
         LI,1     X'1FFFF'          L/WA MASK
         AND,1    2,6               G/AM BUF ADR FROM DCB
         LI,9     X'FFFF'           L/MASK FOR RT HWD
         LW,8     13,1              L/WD 13 OF AM REC (SYSID)
         CS,8     J:JIT             C/SYSIDS
         BNE      ERRA9             BNE; AM REC BAD
*
         REF      RBG
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'
         DESTRUCT MSR01EXIT
BTYC     DATA     X'00FC0000'
AMEXIT   EQU      %
         LI,8     0                  CLEAR ERROR ADDRESSES
         LI,10    0                 FOR PULLALLEXIT
         DESTRUCT PULLALLEXIT
         SPACE    3
BUFCHK   EQU      %
         LW,1     BLK,6
         SLS,1    -17               # BYTES TO READ
         CI,1     0
         BLE      BUFERR            ZERO - BAD
         CI,1     2048
         BLE      *11               OK - RETURN
BUFERR   EQU      %                 YES
         LI,10    X'4A'             ILLEGAL BUFFER OR RECORD ZSIZE
         DESTRUCT MSR01EXIT
*
*
NOWRITE  EQU      %
         LI,10    X'14'             ILLEGAL WRITE REQUEST
         DESTRUCT MSR01EXIT
*
*
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    QBUF,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
*
         REF      DCT22,DISCLIMS
*
*   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
         CAL1,8   WAIT              WAIT 1.2 SEC AND ....
         B        RPOPEN            ... TRY AGAIN
WAIT     DATA     X'0F000001'       FPT FOR 1.2 SEC WAIT
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
         LH,R0    M:XX
         CI,R0    X'20'             IS M:XX OPEN
         BAZ      %+3               B/ NOT OPEN
         LI,R6    M:XX
         BAL,R11  CLOSESAVE         CLOSE IT
         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,R0    RDRPM             ADDRESS OF MESSAGE FOR OPERATOR
         LW,R7    Y4                BYPASS BUFFER CHECKING
         STS,R7   J:ASSIGN
         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
STPOVRSZ EQU      %-STSIZ
         END      STPOVR

