*M*      LNKTRC   M:LINK/M:LDTRC CAL PROCESSOR
*P*
*P*      NAME:    LNKTRC
*P*
*P*      PURPOSE: TO PROCESS THE M:LINK AND M:LDTRC CAL'S AND TO
*P*               CLEAN UP ANY TEMPORY FILES BUILT BY M:LINK WHEN
*P*               THE USER IS RUNDOWN FOLLOWING AN EXIT OR ABORT.
*P*               THE CODE FOR AUTOSAVE ON LINE HANGUP IS
*P*               CONTAINED PRIMARILY IN LNKTRC.
*P*               LNKTRC ALSO PROCESSES THE FIND AND ASSOCIATE
*P*               SUSPENDED IMAGE CALS AND THE M:COUPLE/
*P*               M:DECOUPLE CALS.
*P*
*P*      DESCRIPTION:  AN M:LINK CAL CAUSES THE USER PROGRAM TO BE
*P*               SAVED IN A TEMPORARY FILE AND CONTROL TO TRANSFER
*P*               TO THE SPECIFIED PROGRAM.  AN M:LDTRC CAL RESTORES
*P*               THE SAVED PROGRAM AND TRANSFERS CONTROL TO IT.
*P*
*P*               A CALL FOR CLEAN-UP CAUSES THE TEMPORARY FILE BUILT
*P*               AS A RESULT OF M:LINK CALS TO BE RELEASED.
*P*
*P*               ON DETECTION OF A LINE HANGUP, A USER'S SWAP IMAGE
*P*               MAY BE RETAINED FOR A CERTAIN PERIOD OF TIME. THIS
*P*               ALLOWS HIM TO RE-ESTABLISH THE CONNECTION AND
*P*               RESUME WHERE HE LEFT OFF VIA THE FIND AND ASSOCIATE
*P*               SUSPENDED IMAGE CALS.
*P*
*P*               THE M:COUPLE/M:DECOUPLE CALS ALLOW A GROUP OF
*P*               USERS TO LINK THEIR TERMINALS TOGETHER AND
*P*               UNLINK THEM, AT THEIR DISCRETION.
*P*
*P*               THE CODE IN LNKTRC IS EXECUTED MAPPED AND IN THE
*P*               MASTER MODE.
*P*
         PAGE
*        CREATED 12/29/71  PJH
         SYSTEM   UTS
         CSECT    0
LNKTRC:  RES
         DEF      LNKTRC:           PATCHIMG DEF
         B        LDSTART
         DEF      T:COUPL           M:COUPLE/M:DECOUPLE CAL HANDLER
         PAGE
*
*        JIT REFS
*
         REF      J:JIT             WORD ADDR OF THE JIT
         REF      JIT               WORD ADDR OF THE JIT
         REF      J:ACCN            2 WORDS FOR USER'S ACCOUNT
         REF      J:UNAME           USER'S NAME
         REF      ERO               ERROR CODE
         REF      J:ASSIGN          1 BIT FLAGS
         REF      J:CFLGS           FLAGS FOR LINK/LDTRC TO SHARED PROC
         REF      J:EXLY            * DON'T SET ME FOR X'C0' USERS
         REF      J:EXTENT          FLAGS AND ADDR OF EXIT CONTROL ROUTINE
         REF      J:INTENT          BREAK CONTROL ROUTINE ADDR
         REF      J:TIMENT          M:STIMER ROUTINE ADDR
         REF      J:ICBHDR          WA(ACTIVE DOLIST)
         REF      J:UTIMER          TIME INTERVAL FOR M:STIMER CAL
         REF      J:USENT           USRE'S TRAP CONTROL ROUTINE ADDR
         REF      J:DCBLINK         ADDR OF THE DCB TABLE
         REF      J:RNST            RUN STATUS
         REF      J:UPRIV           USER PRIVILEGE FLAGS
         REF      J:PPRIV           PROCESSOR PRIVELIGE FLAGS
         REF      JB:PRIV           OLD USER PRIV BYTE
         REF      J:STAR            LIST OF STAR FILE FIT DISC ADDR
         REF      J:TCB             TCB ADDR OF EXECUTING PROGRAM
         REF      J:TREE            TREE TABLE ADDR OF EXECUTING PROGRAM
         REF      J:TELFLGS         USED FOR JOB STEP BIT
         REF      J:BUP             VP# OF BEGINNING USER'S PAGE
         REF      J:DLL             VP# OF FIRST DATA PAGE
         REF      J:DUL             VP# OF LAST DATA PAGE
         REF      J:DCBLL           VP# OF FIRST DCB PAGE
         REF      J:DCBUL           VP# OF LAST DCB PAGE
         REF      J:PLL             VP# OF FIRST PROCEDURE PAGE
         REF      J:PUL             VP# OF LAST PROCEDURE PAGE
         REF      J:DDLL            VP# OF FIRST DYNAMIC DATA PAGE
         REF      J:DDUL            VP# OF LAST DYNAMIC DATA PAGE
         REF      JB:PCP            # OF PGS OF PROC/DATA/DYN. DATA/CONTEXT
         REF      JB:TDP            TOP DYNAMIC PAGE (BYTE 0)
         REF      JB:BCP            BOTTOM COMMON PAGE (BYTE 1)
         REF      JB:PROMPT         PROMPT CHAR
         REF      JBBCP             BYTE INDEX TO JB:BCP
         REF      JBPCDD            INDEX TO PAGE COUNT OF DYNAMIC DATA
         REF      JBUPVP            DEFAULT BEGINNING USER PAGE (X'50')
         REF      JSBUF1VP          VP# OF SPECIAL WINDOW PAGE 1
         REF      SBUF1VPA          ADDR OF BUFFER USED FOR JIT INFO RECORD
         REF      SBUF2VPA          ADDR OF BUFFER USED FOR DCB CHECKINGG
         REF      JSPVP             VP# OF DELTA'S DATA PAGE
         REF      SPDBASE           WORD ADDR OF DELTA'S DATA PAGE
         REF      JB:LMAP           USER'S VIRTUAL PAGE CHAIN
         REF      JX:CMAP           USER'S PHYSICAL PAGE MEMORY MAP
         REF      JH:LDCF           PERIPHERAL AUTHORIZATION FLAGS
         REF      M:UC              USED TO GET/RESTORE LINE NUMBER
         REF      COCLN             DISPLACEMENT INTO M:UC TO LINE #
         REF      M:XX              DCB FOR USE BY THE SYSTEM
         REF      J:CCBUF           CONTROL COMMAND BUFFER
         REF      JB:CCARS          BYTE COUNT OF STRING IN J:CCBUF
         REF      J:ALB             CAL3 INTERRUPT VECTOR IN JIT
         REF      J:XPSD            XPSD BLOCK FOR CAL3 IN JIT
         REF      J:JIP             DOUBLEWORD ADDRESS OF JOBENT DCB
         REF      JB:ALN            SAVE ACTUAL LINE NUMBER
*
*        USER TABLE REFS
*
         REF      UH:FLG            USER FLAGS
         REF      UH:FLG2           CONTAINS HANGUP FLAGS
         REF      U:MISC            SET TO RETENTION TIME FOR HUNGUP USER
         REF      UH:WL             HOLDS COC BUF PTR. FOR HUNGUP USER
         REF      UH:DL             DO LIST. CHECKED FOR ABORTS.
         REF      UB:ACP            USER'S COMMAND PROCESSOR #
         REF      UB:APR            ASSOCIATED STANDARD SHARED PROCESSSOR #
         REF      UB:APO            OVERLAY # OF ASSOCIATED SHARED PROCESSOR
         REF      UB:ASP            ASSOCIATED SPECIAL SHARED PROCESSOR #
         REF      UB:DB             ASSOCIATED DEBUGGER #
*
*        SHARED PROCESSOR TABLE REFS
*
         REF      P:NAME            ROOT OR OVERLAY NAME IN TEXTC FORMAT
         REF      PNAMEND           INDEX# + 1 OF LAST ROOT ENTRY
         REF      P:SA              FLAGS AND START ADDRESS
         REF      PB:PSZ            # OF PAGES OF PURE PROCEDURE
         REF      PB:PVA            VP# OF FIRST PROCEDURE PAGE
         REF      PB:UC             # OF IN-CORE USERS ASSOCIATED
         REF      PB:REP            TOTAL # OF USERS ASSOCIATED
*
*        MONITOR DATA
*
         REF      S:CUN             CURRENT USER NUMBER
         REF      SMUIS             MAX NO OF USERS ON SYSTEM
         REF      SV:FTYM           LENGTH OF SH:SYMT
         REF      SH:SYMT           TABLE CONTAINING FAUTH-ED FEATURES
         REF      DOUBLEZERO        DOUBLE WORD OF ZEROS
         REF      HEX               USED TO CONVERT TO BCD
         REF      SL:RET            RETENTION TIME FOR HUNGUP USERS
         REF      CAL3PSD           INITIAL VALUE FOR CAL3 VECTOR
         REF      PR:MS             MASTER MODE PRIV BIT
         REF      NEWQ
         REF      QUEUE1            FOR M:SYS LIKE REGISTER RETURNED
         REF      QUEUE             ADDRESSES.
*
*        MASKS
*
         REF      MASKS             1->32 BIT MASKS
         REF      NB31TO0           31 BIT MASKS
         REF      X7F               MASK
         REF      XFC
         REF      X10
         REF      X4
         REF      X400
         REF      X40
         REF      YF
         REF      YFF
         REF      Y2
         REF      Y004
         REF      Y008
         REF      Y07
*
*        MM REFS
*
         REF      T:GBUF            TO GET A SPEC. BUFFER FOR THE JIT
*,*                                  INFO RECORD AND FOR THE DCB CHECKER
         REF      T:RBUF            TO RETURN A SPECIAL BUFFER
         REF      T:ZBUF            TO RELEASE ALL FM BUFERS
         REF      FPMC              TO CHECK FOR FREE PAGE IN USER AREA
         REF      T:PAC             TO LOAD THE ACCESS CODES FOR THE
*,*                                  SPECIAL SHARED PROCESSOR AREA
         REF      T:SAC             TO RESET THE ACCESS CODES AFTER
*,*                                  RELEASING USER PAGES
         REF      T:TOTESZ          TO FIND USER SIZE WHEN RESTORING
*,*                                  A SHARED LIBRARY OR DEBUGGER
         REF      T:GNVPI           TO GET PAGES FOR RESTORING PROGRAM
         REF      T:RVPI            TO RELEASE CORE FOR PROGRAM ISSUING
*,*                                  AN M:LINK/M:LDTRC CAL
*
*        T:OV REFS
*
         REF      CLSALL#           TO CLOSE ALL USER DCBS
         REF      CLSSEG            FOR CLSALL#
         REF      DCBCHK#           TO VALIDATE RESTORED DCBS
         REF      STEPOVRSEG        FOR DCBCHK#
         REF      MISOVSEG          FOR T:JECLS#
         REF      T:JECLS#          TO RELEASE JOBENT GRANULES
*
*        SCHED REFS
*
         REF      T:REG             REPORT EVENT AND GIVE UP
         REF      T:SSEM            SCHEDULER ENTRY FOR RESTARTING
*,*                                 HUNGUP USER
         REF      E:WU              SCHEDUER WAKEUP EVENT
         REF      T:RUE             ROUTINE TO REPORT EVENT ON A
*,*                                 PARTICULAR USER.
         REF      E:SL              SLEEP EVENT
         REF      E:AP              TO REASSOCIATE LIBRARY/DEBUGGER A
*,*                                  AFTER M:LDTRC
         REF      TRAPEXIT          EXIT FOR T:FSI AND T:ASI
*
*        STEP REFS
*
         REF      T:ABORTM          TO ABORT THE USER
         REF      T:ASP             TO LOAD A NEW PROGRAM FOR M:LINK;
*,*                                  TO RESTORE SHARED PROC FOR M:LDTRC
*
*        COC TABLE SREFS
*
         SREF     LB:UN             USER # ASSOCIATED WITH COC LINE
         SREF     COCGETB           COC GET BUFFER ROUTINES
         SREF     COCPUTBL          COC RELEASE BUFFER ROUTINE
         SREF     COCBUF            HEAD OF COC BUFFER POOL
         SREF     COCDSABL          ROUTINE TO DISABLE COC INTERRUPTS
         SREF     COCENABL          ROUTINE TO ENABLE COC INTERRUPTS
         SREF     COCOC             COUNT OF REMAINING CHARS TO OUTPUT
         REF      COCGLN            GET COC LINE #
         SREF     COCSENDX          SEND 'PROGRAM HELD'
         SREF     MODENO            SAVE LINE STATUS ON DISCONNECT
         SREF     MODE2             CONTAINS ACTIVATION CHAR. SET
         SREF     MODE4             USED FOR TIMING ALG.
         SREF     BUFCNT            COUNT OF COC BUFFERS IN USE
         SREF     DECOUPLE%         DECOUPLE LOGIC IN COC
         SREF     TIE               TERMINAL COUPLING TABLE
         SREF     COCPCIB           COC PUT CHAR. ROUTINE
         SREF     COCOTV            OUTPUT XLATE VECTOR
         SREF     ECHOCR            ECHOES A CARRIAGE RETURN
         SREF     LNOL              NO. OF COC LINES
         SREF     S:COUP            MAGIC COUPLING FLAG CELL
         SREF     COCTERM           TERMINAL TYPE
*
*        REAL-TIME SREFS
*
         SREF     ICB               WA(FIRST SYSGEN ICB)
         SREF     ICBSIZE           SIZE OF A SYSGEN-BUILT ICB
         SREF     NINTS             # OF ICBS BUILT BY SYSGEN
         PAGE
*
*        FORMAT OF SBUF1VP
*
*
* FIRST HALF PAGE        CONTAINS THE JIT INFORMATION RECORD OF THE IDN FILE
*
* WORD  0    J:INTENT
* WORD  1    J:TIMENT
* WORD  2    J:UTIMER
* WORD  3    J:USENT
* WORD  4    J:TCB
* WORD  5    J:TREE
* WORD  6    USER PSD
* WORD  7    USER PSD
* WORD  8    J:BUP
* WORD  9    J:EUP
* WORD  A    J:PLL
* WORD  B    J:PUL
* WORD  C    J:DLL
* WORD  D    J:DUL
* WORD  E    J:DDLL
* WORD  F    J:DDUL
* WORD 10    J:DCBLL
* WORD 11    J:DCBUL
* WORD 12    PROCESSOR FLAGS  (APR,APO,DB,ASP)
* WORD 13    UH:FLG
* WORD 14    JB:TDP  (TOP DYNAMIC PAGE)
* WORD 15    PROCEDURE SIZE (SIZE OF RECORD 4)
* WORD 16    DCB SIZE  (SIZE OF RECORD 2)
* WORD 17    DATA SIZE  (SIZE OF RECORD 3)
* WORD 18    DYNAMIC DATA SIZE (SIZE OF RECORD 5)
* WORD 19    SYMBOL TABLE SIZE (SIZE OF RECORD 6)
* WORD 1A    J:EXTENT
* WORD 1B    PROCESSOR/USER FLAG (J:RNST)
* WORD 1C    SYMBOL TABLE ADDRESS
* WORD 1D    J:UPRIV
* WORD 1E-28 M:XX NAME/ACCT/PASSWORD
* WORD 29    J:ALB, CAL3 VECTOR ADDRESS
* WORD 2A-2B J:XPSD+2, J:XPSD+3 USER CAL3 TRAP HANDLER ADDRESS
* WORD 2C-33 7 WORDS FOR PATCHES
* WORD 34-47 CONTENTS OF J:CCBUF
*
*        BUFFER FOR HEADER AND TRAILER RECORDS
*
* WORD 16D        FLAG WORD FOR LDLNK CLEANUP
* WORD 16E        ID-N    IDENTIFIES SET OF RECORDS
* WORD 16F        # RECORDS IN SET (0 IF HEADER)
* WORD FF     # RECORDS IN SET (0 IF HEADER)
*
*
*
* SECOND HALF PAGE        CONTAINS THE USERS ENVIRONMENT AND THE FPT
*
* WORD 170-173    USER'S PSD
* WORD 174-182    USER'S REGISTERS 0-15
* WORD 183-1A0    M:LINK OR M:LDTRC FPT
* WORD 1A0-1A9    COMMAND BEING PASSED IF (CMD) OPTION SPECIFIED
* WORD 1B0-1B1    TEXTC DEBUGGER NAME
*
*
* THE FOLLOWING LABELS ARE USED TO REFERENCE DATA IN SBUF1VP
*
INTEDISP EQU      0
PSDDISP  EQU      6
BUPDISP  EQU      8
DCBLLDISP EQU     16
PRFLDISP EQU      18
FLGDISP  EQU      19
TDPDISP  EQU      20
PRSZDISP EQU      21
DCBSDISP EQU      22
DSZDISP  EQU      23
DDSDISP  EQU      24
STSZDISP EQU      25
XITDISP  EQU      26
PRUSDISP EQU      27
SYMTABDISP EQU    28
UPRVDISP EQU      29
MXXDISP  EQU      30
C3VDISP  EQU      41
C3ADISP  EQU      42
PATCHDISP EQU     44
FLAGDISP EQU      X'16D'
IDNDISP  EQU      X'16E'
NRECDISP EQU      X'16F'
ERODISP  EQU      X'170'
UPDSDISP EQU      X'170'
PSD1DISP EQU      X'171'
REGDISP  EQU      X'174'
SR1DISP  EQU      X'17B'
FPTDISP  EQU      X'183'
CMDDISP  EQU      X'1A0'
DBUGDISP EQU      X'1B0'
JINFOSZ  EQU      4*51
CCBSIZ   EQU      80
BASBUF1  EQU      SBUF1VPA+SBUF1VPA+SBUF1VPA+SBUF1VPA
         PAGE
*
*        SYMBOLIC REGISTER DEFINITIONS
*
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
SR1      EQU      8
R9       EQU      9
SR2      EQU      9
R10      EQU      10
SR3      EQU      10
R11      EQU      11
SR4      EQU      11
R12      EQU      12
D1       EQU      12
R13      EQU      13
D2       EQU      13
R14      EQU      14
D3       EQU      14
R15      EQU      15
D4       EQU      15
         PAGE
*  PROC FOR SETTING ASSIGN BIT TO BYPASS BUF LIMITS CHECK
BBLC     CNAME
         PROC
LF       RES      0
         LW,AF(1) Y4
         STS,AF(1)  J:ASSIGN
         PEND
       BOUND      8
TCLOGON  TEXTC    'LOGON'
SAVCCBUF GEN,32,8,24  BA(J:CCBUF),CCBSIZ,JINFOSZ+BASBUF1
GETCCBUF GEN,32,8,24  JINFOSZ+BASBUF1,CCBSIZ,BA(J:CCBUF)
BLANKS   TEXT     '      '
X1FFFF   DATA     X'1FFFF'
XFFFF    DATA     X'FFFF'
XFFD7    DATA     X'FFD7'
XFBFF    DATA     X'FBFF'
XEFFF    DATA     X'EFFF'
Y04      DATA     X'04000000'       * J:EXLY MASKING BIT
YC       DATA     X'C0000000'
Y8       DATA     X'80000000'
Y4       DATA     X'40000000'
Y003E    DATA     X'003E0000'
Y03      DATA     X'03000000'
Y002     DATA     X'00200000'
YFFFFFF  DATA     X'FFFFFF00'
XFFFE    EQU      NB31TO0+1
CR       EQU      '
'               CARRIAGE RETURN CHARACTER
TCPH     TEXTC    CR,'PROGRAM HELD',CR
         PAGE
*
*                 FPTS USED BY LNKTRC
*
* SHUTDCB USED TO:  CLOSE/SAVE M:XX ON LINK/LDTRC/LEXIT
*                   CLOSE/SAVE IDN FILE ON LINK
*
SHUTDCB  GEN,1,7,24 1,X'15',4
         GEN,1,31 1,0
         GEN,24,8 0,2               SAVE SPECIFIED
*
* OPNFPT USED TO: BUILD IDN FILE ON LINK
*                 RESTORE IDN FILE ON LDTRC
*                 ACCESS IDN FILE FOR LEXIT
*
OPNFPT   GEN,8,24 X'14',M:XX        FPT FOR REGS 0
         DATA     X'C7400001'                    1
         DATA     ABORT             ERR          2   NOTE: SET TO LEX4
         DATA     ABORT             ABN          3      IF OPEN ON LEXIT
         DATA     1                 ORG-CONSEC   4
         DATA     1                 ACCESS-SEQ   5
         DATA     2                 MODE-OUT     6
         DATA     2                 SAVE         7
         DATA     X'01000101'       NAME INDIC   8
         DATA     0                 NAME         9
ACCNIND  DATA     X'02000202'       ACCT INDIC   10
         DATA     0,0               ACCT         11,12
PSINDIC  DATA     X'03010000'       PSWD INDIC   13
*
* WRITE USED TO WRITE IDN FILE ON LINK
*
WRITECAL SLD,0    9                 WORD ADDR OF BUFFER
         SLS,1    2                 BYTE SIZE
         CAL1,1   WRITE
         B        0,4
*
WRITE    GEN,8,24 X'11',M:XX
         DATA     X'F0000000'
         DATA     WRTERR
         DATA     WRTERR
         GEN,1,31 1,0               BUF IN REG 0
         GEN,1,31 1,1               SIZE       1
*
* READ USED TO: RESTORE IDN FILE ON LDTRC
*               READ JIT AND DCBS FROM IDN ON LEXIT
*
READCAL  SLD,0    9                 WORD ADDR OF BUFFER
         SLS,1    2                 BYTE SIZE
         BBLC     3
         CAL1,1   READ
         B        0,4
*
READ     GEN,8,24 X'10',M:XX
         DATA     X'F0000000'
         DATA     RDERR
         DATA     RDERR
         GEN,1,31 1,0               BUF IN REG 0
         GEN,1,31 1,1               SIZE       1
*
* TRNKFPT AND CHECKFPT USED TO RELEASE FILE BLOCKING
*                              BUFFERS ON LINK/LDTRC
*
TRUNKFPT DATA     X'92000006'       DCB ADR IN 6
         DATA     0
CHECKFPT DATA     X'A9000006'
         DATA     X'80000000'
         DATA     CKERR
*
* CLOSEWDO USED TO: CLOSE/RELEASE IDN FILE ON LDTRC/LEXIT
*                   CLOSE/RELEASE USER DCBS ON LDTRC/LEXIT
*
CLOSEWD0 GEN,8,24 X'95',6
         DATA     X'80000000'
         DATA     2                 SAVE
*
PFILE    GEN,8,7,17 X'1C',0,M:XX
         DATA     0                 SKIP TO EOF
*
READR    GEN,8,7,17 X'10',0,M:XX
         DATA     X'F0000020'       READ REVERSE
         DATA     RDERR
         DATA     RDERR
         GEN,1,31 1,0               BFR IN 0
         GEN,1,31 1,1               SIZE IN 1
*
PREC     GEN,8,7,17 X'1D',0,M:XX
         DATA     X'C0000010'       REVERSE
         GEN,1,31 1,1               # OF RECS IN 1
         DATA     PRERR
*
DELREC   GEN,8,7,17 X'0D',0,M:XX
         DATA     0
*
READF    GEN,8,7,17 X'10',0,M:XX
         DATA     X'F0000000'
         DATA     LEX2              ERROR
         DATA     LEX3              ABNORMAL
         GEN,1,31 1,0               BUF IN 0
         GEN,1,31 1,1               SIZE IN 1
*
SYSACT   TEXT     ':SYS'
         TEXT     '    '
         PAGE
*F*
*F*      NAME:    LDSTART
*F*
*F*      PURPOSE: LDSTART IS THE ONLY ENTRY POINT TO THE LNKTRC
*F*               MODULE AND MUST TRANSFER CONTROL TO THE PROPER
*F*               ROUTINE TO PERFORM THE REQUESTED FUNCTION.
*F*
*F*      DESCRIPTION:  LDSTART IS ENTERED WITH R0 AND R8 SET AS FOLLOWS:
*F*               R0 = 1 IF M:LINK OR M:LDTRC
*F*                                 R8 = 02 IF M:LINK
*F*                                    = 03 IF M:LDTRC
*F*               R0 = 2 IF CLEANUP
*F*                  = 3 IF AUTOSAVE REQUEST
*F*                  = 4 IF FIND SUSPENDED IMAGE
*F*                  = 5 IF ASSOCIATE SUSPENDED IMAGE
*F*                  = 6 IF M:COUPLE OR M:DECOUPLE
*F*                  = 7 IF M:CAL FOR CAL3
*F*                  = 8 IF IMPLICIT M:LDTRC ON EXIT, ERR, OR ABORT
*F*
*F*               BASED ON THE CONTENTS OF R0, LDSTART WILL TRANSFER
*F*               CONTROL TO THE PROPER ROUTINE.
*F*
*
* DRIVER FOR LDLNKSEG
*
LDSTART  EQU      %
         BLOCK                      DONT RUN ON SLAVE CPU'S
         AI,0     DRIVE
         B        *0
DRIVE    EQU      %-1
         B        LINK%LDTRC        M:LINK OR M:LDTRC
         B        LEXIT             LOAD-AND-LINK CLEANUP
         B        T:SAVESWAPIMG     AUTOSAVE ON LINE HANGUP
         B        T:FSI             FIND SUSPENDED IMAGE CAL
         B        T:ASI             ASSOCIATE SUSPENDED IMAGE CAL
         B        T:COUPL           M:COUPLE OR M:DECOUPLE
         B        T:CAL             M:CAL FOR CAL3 CONTROL
         B        LDTSETUP          IMPLICIT LDTRC ON EXIT,ERR,XXX
         SPACE    4
*  GO TO EITHER LINK OR LDTRC
LINK%LDTRC EQU    %
         PUSH     11
         PUSH     2,6
         CI,8     2                 IS IT LOAD & LINK
         BNE      LDT0              NO-MUST BE LOAD & TRANSFER
         PAGE
*F*
*F*      NAME:    LNK0
*F*
*F*      PURPOSE: TO PROCESS THE M:LINK CAL.
*F*
*F*      DESCRIPTION:  LNK0 MAINTAINS A CONSECUTIVE TEMPORARY FILE
*F*               NAMED 'IDN' WHERE ID = THE 2 BYTE USER ID, IN HEX,
*F*               FROM THE 1ST WORD OF J:JIT.  A SET OF CONSECUTIVE
*F*               RECORDS CONTAINING INFORMATION FOR THE SAVED
*F*               PROGRAM IS WRITTEN ON EACH M:LINK CAL.  THIS
*F*               SET OF RECORDS IS AS FOLLOWS:
*F*
*F*               2 WORD HEAD      ID0X      ID=USER ID (IN HEX)
*F*                  RECORD        0000      0X=CONSECUTIVE COUNT OF
*F*                                              M:LINK CALS
*F*               RECORD1          JIT INFORMATION RECORD
*F*               RECORD2          DCBS (IF ANY)
*F*               RECORD3          DATA (IF ANY)
*F*               RECORD4          PROCEDURE (IF ANY)
*F*               RECORD5          DYNAMIC DATA (IF ANY)
*F*               RECORD6          DELTA'S SYMBOL TABLE (IF ANY)
*F*               RECORD7          DELTA'S DATA PAGE (IF ANY)
*F*
*F*               2 WORD TRAILER  ID0X
*F*                  RECORD       # OF RECORDS PRECEEDING TRAILER RECORD
*F*
*F*
*F*               AFTER THIS INFORMATION CONCERNING THE CALLING PROGRAM
*F*               IS WRITTEN, THE USER'S CORE IS RELEASED AND CONTROL
*F*               PASSES TO THE ASSOCIATE PROGRAM LOGIC, T:ASP, IN THE
*F*               STEPOVR OVERLAY TO ASSOCIATED THE CALLED PROGRAM
*F*               AND ENTER IT.
*F*
         PAGE
*D*      NAME:    LNK0
*D*
*D*      INPUT:   R6 = 1ST WORD OF PLIST IN FPT
*D*               R7 = ADDRESS OF PLIST+1 IN FPT
*D*
*D*      DESCRIPTION:  LNK0 CALLS 'TRUNK' WHICH TRUNCATES THE USER'S DCBS,
*D*               CALLS 'VALID' WHICH INSURES IT IS LEGAL TO PERFORM
*D*               THE M:LINK CAL, AND CALLS 'MOVEFPT' WHICH OBTAINS A
*D*               BUFFER AND MOVES THE USER'S ENVIRONMENT AND THE M:LINK
*D*               FPT TO IT.  THE FIRST HALF OF THE BUFFER IS USED TO
*D*               BUILD THE JIT INFORMATION RECORD.
*D*
LNK0     EQU      %
         BAL,11   TRUNK
         BAL,5    VALID
LNK01    EQU      %
         BAL,5    MOVEFPT
*D*
*D*               M:XX IS CLOSED, IF OPEN.
*D*
         LI,4     M:XX
         LCI      3
         LM,0     SHUTDCB
         LW,5     Y002
         CS,5     M:XX              IS IT OPEN
         BNE      %+2               NO  DONT CLOSE
         CAL1,1   0                 CLOSE & SAVE M:XX
*D*
*D*               THE NAME/ACCT/PASSWORD FROM M:XX IS MOVED TO
*D*               THE JIT INFORMATION RECORD.
*D*
         LCI      11
         LM,6     M:XX+23           SAVE M:XX NAME/ACCT/PASS
         STM,6    SBUF1VPA+MXXDISP
*D*
*D*               THE LOW ORDER BYTE IN J:RNST (THE COUNT OF M:LINK
*D*               CALS) IS INCREMENTED AND COMBINED WITH THE USER ID
*D*               TO FORM THE RECORD SET IDENTIFICATION.  THIS ID IS
*D*               STORED IN THE USER'S SR1.
*D*
         LI,7     X'FF'
         AND,7    J:RNST            GET N
         LI,10    0
         CI,7     'B'               FIRST * FILE
         BGE      ABORT
         MTW,1    J:RNST            INCR TO NXT N
         LW,9     J:JIT
         AND,9    XFFFF             SYS ID
         SLS,9    8
         OR,9     7
         OR,9     Y03               ' IDN'
         STW,R9   SBUF1VPA+SR1DISP
*                                   FILE NAME TO USERS SR1
         LI,10    1
         LCI      2
         STM,R9   SBUF1VPA+IDNDISP
         STW,10   M:XX              SET FILE AS DELTA MAY HAVE BEEN USING M:XX
*D*
*D*               THE 'IDN' FILE IS OPENED IN THE OUTPUT MODE UNLESS
*D*               THE FILE ALREADY EXISTS.  IN THAT CASE THE 'IDN' FILE
*D*               IS OPENED IN THE UPDATE MODE AND POSITIONED TO THE
*D*               END OF FILE.
*D*
         AND,9    YFFFFFF
         AI,9     'N'               MAKE IT IDN
         LCI      9
         LM,0     OPNFPT            FPT TO REGS
         LW,10    J:STAR+5          CHK IF *N EXISTS YET
         BEZ      %+2               NOT YET
         LI,6     4                 MODE IS UPDATE
         LW,11    Y4
         STS,11   J:STAR+5          SET ACCESS CTL FLAG
         LCI      4                 REST OF FPT TO REGISTERS
         LM,10    ACCNIND
         LCI      2
         LM,11    J:ACCN            ACCT #
         CAL1,1   0                 OPEN FILE 'IDN'
         CI,6     2                 CHK FOR OUT
         BE       LNK1              IT IS
         LCI      2
         LM,0     PFILE
         CAL1,1   0                 GO TO EOF
*D*
*D*               THE FOLLOWING JIT VALUES ARE SAVED IN THE JIT
*D*               INFORMATION RECORD AND SET TO ZERO IN THE JIT:
*D*                  J:INTENT  BREAK CONTROL ROUTINE ADDRESS
*D*                  J:TIMENT  M:STIMER ROUTINE ADDRESS
*D*                  J:UTIMER  TIME INTERVAL SPECIFIED ON M:STIMER
*D*                  J:USENT   TRAP CONTROL ROUTINE ADDRESS
*D*                  J:TCB     USER TCB ADDRESS
*D*                  J:TREE    TREE TABLE ADDRESS
*D*                  J:EXTENT  EXIT CONTROL ADDRESS
*D*                  J:RNST    PROCESSOR/USER RUNNING
*D*                  J:UPRIV   USER PRIVILEGE FLAGS
*D*
LNK1     EQU      %
         LI,8     0
         LCI      3
         STM,8    9
         XW,8     J:INTENT
         XW,9     J:TIMENT
         XW,10    J:UTIMER
         XW,11    J:USENT
         LW,12    J:TCB
         LW,13    J:TREE
         LW,5     Y04               * FIND THE MASKING BIT
         LS,4     J:EXLY            * FETCH CURRENT EX-ONLY BIT
         STS,4    13      * AND STUFF INTO J:TREE'S SPARE BIT AREA
         LI,4     0                 * NOW, ZAP THE CURRENT EXLY BIT
         STS,4    J:EXLY            * SO STEP CAN SET IT CORRECTLY LATER
         LCI      6
         STM,8    SBUF1VPA+INTEDISP PUT VALUES IN BUFFER
         LI,6     0
         XW,6     J:EXTENT
         STW,6    SBUF1VPA+XITDISP
         LW,6     J:RNST
         STW,6    SBUF1VPA+PRUSDISP
         LW,6     JB:PROMPT
         STB,6    SBUF1VPA+PRUSDISP SAVE PROMPT CHAR
         LW,6     J:UPRIV
         STW,6    SBUF1VPA+UPRVDISP
         LD,4     SAVCCBUF          GET MBS PARAMETERS
         MBS,4    0                 MOVE CCBUF INTO BUFFER
*D*      THE INFORMATION FOR USER CAL3 VECTORING, J:ALB AND
*D*      THE TWO WORD XPSD TARGET ADDRESS IS MOVED TO THE JIT
*D*      INFORMATION RECORD AND RESET IN THE JIT.
         LW,6     J:ALB             VECTOR ADDRESS
         STW,6    SBUF1VPA+C3VDISP
         LI,6     CAL3PSD
         STW,6    J:ALB             RESET TO ROOT ROUTINE
         LD,6     J:XPSD+2          TARGET PSD
         LCI      2
         STM,6    SBUF1VPA+C3ADISP
         LI,6     0
         STW,6    J:XPSD+2
         STW,6    J:XPSD+3          CLEAR OUT OLD PSD
*D*
*D*               THE USERS PSD IS MOVED FROM THE ENVIRONMENT
*D*               TO THE JIT INFORMATION RECORD.
*D*
         LD,R6    SBUF1VPA+UPDSDISP GET PSD FROM USER'S ENVIRONMENT
         LI,9     X'6000'
         LS,8     J:RNST            GET IMPLICIT RETURN BITS
         STS,8    7                 PRESERVE IN TSF OF USER'S PSD
         LCI      2
         STM,6    SBUF1VPA+PSDDISP  USER PSD TO BUFFER
*D*
*D*               JIT MEMORY DELIMITERS ARE MOVED TO THE JIT
*D*               INFORMATION RECORD.
*D*
         LCI      8
         LM,6     J:BUP
         LD,14    J:DCBLL
         LCI      10
         STM,6    SBUF1VPA+BUPDISP
*D*
*D*               THE 'PROCFLAG' ROUTINE IS CALLED TO GET THE PROCESSOR
*D*               NUMBER OF ALL ASSOCIATED SHARED PROCESSORS AND THE
*D*               CURRENT SETTING OF UH:FLG.
*D*
         BAL,5    PROCFLG           6=APR,APO,ASP&DB  7=FLAGS
*D*
*D*               THE SIZE OF EACH RECORD TO BE WRITTEN TO THE FILE
*D*               IS COMPUTED AND STORED IN THE JIT INFORMATION RECORD.
*D*
         LB,8     JB:TDP
         BNEZ     %+2               IF = 0 ITS AN EXTENDED USER WITH
         LI,8     X'100'             DD TO THE TOP OF VIRTUAL CORE
         MTB,0    6                 SHARED PROCESSOR RUNNING
         BEZ      %+3               NO-GET PROCEDURE SIZE
         LI,9     0
         B        LNK2
         SW,9     J:PLL             PUL-PLL
         AI,9     1                  +1 = PROC SIZE
         BEZ      %+2
         MTW,1    SBUF1VPA+NRECDISP BUMP COUNT OF RECORDS
LNK2     SW,11    J:DLL             DLL-DUL
         AI,11    1                  +1 = DATA SIZE
         BEZ      %+2
         MTW,1    SBUF1VPA+NRECDISP BUMP COUNT OF RECORDS
         SW,15    J:DCBLL           DCBUL-DCBLL
         AI,15    1                  +1 = DCB SIZE
         STW,15   10                PACK THEM UP
         BEZ      %+2
         MTW,1    SBUF1VPA+NRECDISP BUMP COUNT OF REOCRDS
         LW,12    8                 TDP
         SW,12    J:DDLL            TDP-DDLL
         BEZ      %+2                = DD SIZE
         MTW,1    SBUF1VPA+NRECDISP BUMP COUNT OF RECORDS
         LW,13    J:BUP             ADDR OF SYM TAB PAGE IS
         AW,13    9                  AT END OF USER PROGRAM
         AW,13    10
         AW,13    11
         LW,14    13                SYM TAB PAGE
         LW,13    J:DDLL
         SW,13    J:PUL
         AI,13    -1                # OF PAGES
*        SEE IF SYM TAB PAGES ARE ALLOCATED
         LW,5     14                SYM TAB PAGE
         LW,3     13                # OF PAGES
         BLEZ     LNK4
LNK3     LOAD,2   JX:CMAP,5
         CI,2     FPMC              IS IT ALLOCATED
         BE       LNK4              NO
         AI,5     1                 NEXT PAGE
         BDR,3    LNK3
LNK4     SW,13    3                 TAKE OUT UNALLOCATED PGS
         BEZ      %+2               NONE ALLOCATED
         MTW,1    SBUF1VPA+NRECDISP BUMP COUNT OF RECORDS
LNK41    EQU      %
         LI,4     X'FF00'
         AND,4    6                 IS DELTA ASSOCIATED
         BEZ      %+2               NO
         MTW,1    SBUF1VPA+NRECDISP  YES - BUMP COUNT FOR DATA PAGE
         LCI      8
         STM,6    SBUF1VPA+PRFLDISP
         LB,4     JB:CCARS          GET SIZE OF COMMAND STRING
         STB,4    14                SAVE IT HIGH BYTE OF SYMTAB ADDRESS
         STW,14   SBUF1VPA+SYMTABDISP
*D*
*D*               THE HEADER RECORD IS WRITTEN TO THE IDN FILE.
*D*
         LI,4     0
         XW,R4    SBUF1VPA+NRECDISP
         LI,R0    SBUF1VPA+IDNDISP
         LI,1     8                 2 WORDS
         BBLC     5                 FAKE BFR CHKR
         CAL1,1   WRITE             NAME & A WORD OF ZERO
         STW,R4   SBUF1VPA+NRECDISP # OF RECORDS FOLLOWING
*D*
*D*               NEXT THE JIT INFORMATION RECORD IS WRITTEN.
*D*
         LI,0     SBUF1VPA          BUFFER
         LI,1     JINFOSZ+CCBSIZ    SIZE FOR WRITE
         BBLC     5
         CAL1,1   WRITE
*D*
*D*               IF THE PROGRAM HAS ANY DCBS, THE DCB RECORD IS WRITTEN.
*D*
         LW,1     10                # PAGES OF DCBS
         BEZ      LNK5
         LW,0     J:DCBLL           BUF FOR DCBS
         BAL,4    WRITECAL
*D*
*D*               THE DATA RECORD, IF THE PROGRAM HAS DATA, IS WRITTEN.
*D*
LNK5     LW,1     11                # PAGES OF DATA
         BEZ      LNK6
         LW,0     J:DLL             BUF FOR DATA
         BAL,4    WRITECAL
*D*
*D*               THE PROCEDURE RECORD, IF ANY, IS WRITTEN.
*D*
LNK6     LW,1     9                 # PGS OF PROCEDURE
         BEZ      %+3               NONE
         LW,0     J:PLL
         BAL,4    WRITECAL
*D*
*D*               NEXT, THE DYNAMIC DATA RECORD, IF ANY, IS WRITTEN
*D*
         LW,1     12                # PGS OF DYNAMIC DATA
         BEZ      %+3
         LW,0     J:DDLL
         BAL,4    WRITECAL
*D*
*D*               IF THERE ARE ANY SYMBOL TABLE PAGES THEY ARE
*D*               THEN WRITTEN TO THE IDN FILE.
*D*
         LW,1     13                # PGS OF SYM TABLE
         BEZ      %+3
         LW,0     14
         BAL,4    WRITECAL
*D*
*D*               IF DELTA WAS ASSOCIATED, DELTA'S DATA PAGE IS
*D*               WRITTEN TO THE IDN FILE.
*D*
LNK65    LI,4     X'FF00'
         AND,4    6                 IS DELTA ASSOCIATED
         BEZ      LNK7              NO
         BBLC     1                 FAKE BUFFER CHECK
         LI,0     SPDBASE           DELTA'S DATA PAGE
         LI,1     512*4             BYTE SIZE
         CAL1,1   WRITE             WRITE OUT DELTA'S DATA PAGE
*D*
*D*               THE TRAILER RECORD IS THEN WRITTEN.
*D*
LNK7     BBLC     1                 FAKE BFR CHKR
         LI,R0    SBUF1VPA+IDNDISP
         LI,1     8                 2 WORDS
         CAL1,1   WRITE             NAME & # OF RECORDS
*D*
*D*               THE 'IDN' FILE IS THEN CLOSED SPECIFYING SAVE.
*D*
         LI,4     M:XX
         LCI      3
         LM,0     SHUTDCB
         CAL1,1   0
*D*
*D* THE SPECIAL JIT BITS FOR ACTION ON ERROR, EXIT
*D* AND COMMAND STRING PASSING IN J:CCBUF ARE THEN SET UP.
*D*
         LW,4     TSTACK
         LW,4     -1,4              GET WD0 OF FPT OUT OF STACK
         SLS,4    10                ALIGN EXIT,ERR BITS TO JIT POSITIONS
         LI,5     X'6000'           AND...
         STS,4    J:RNST            STORE THEM IN THE JIT
         LI,8     0                 ALWAYS RESET CCSTAT
         LW,9     J:RNST
         CW,9     Y008              IS CCBEF SET
         BAZ      %+2               B IF NOT
         AI,8     X'8000'           SET CCSTAT2 IF CCBEF SET
         CI,4     X'1000'           WAS CMD PRESENCE BIT ON
         BAZ      %+2
         OR,8     Y004              SET PCCF IF CMD BEING PASSED
         LW,9     Y004              BUILD MASK FOR STS
         AI,9     X'18000'
         STS,8    J:RNST            AND STORE PCCF,CCSTAT,CCSTAT2
         LI,5     X'9000'           MASK FOR (CMD) AND (CMD,XX)
         AND,5    4                 ISOLATE TWO BITS
         CI,5     X'1000'           WAS (CMD) SPECIFIED? (NOT (CMD,XX)!)
         BNE      LNK8              NO - DON'T MOVE IT
         LW,5     *TSTACK           POINTER TO FPT+1 IN BUFFER
         LW,9     5                 COPY PTR FOR GETREG
         LB,3     *5
         SLS,3    -2
         AI,3     1                 GET WORD COUNT OF LMN
         CI,4     X'800'            ACCNT IN FPT?
         BAZ      %+2               NO
         AI,3     2                 ADD 2 WORDS FOR ACCOUNT
         CI,4     X'400'            PASSWORD IN FPT?
         BAZ      %+2               NO
         AI,3     2                 ADD 2 WORDS FOR PASSWORD
         AW,3     5                 POINT TO COMMAND STRING POINTER
         LW,12    *3                GET POINTER TO COMMAND STRING
         BGEZ     %+4               B IF NOT INDIRECT
         BAL,5    GETREG            ADJUST IF A REGISTER REF
         BAL,13   ADDRCHK           CHECK FOR VALID ADDRESS
         LW,12    *12               GET INDIRECT REF
         BAL,5    GETREG            ADJUST IF A REGISTER REF
         BAL,13   ADDRCHK           CHECK BEGINNING OF STRING
         LB,2     *12               GET LENGTH
         SLS,2    -2                MAKE INTO WORD OFFSET OF END
         AW,12    2                 POINT TO LAST WORD IN STRING
         BAL,13   ADDRCHK           CHECK END OF STRING
         SW,12    2                 POINT BACK TO BEGINNING
         LB,5     *12               CHAR CNT OF CMD STRING
         BEZ      LNK8              NULL CMD STRING
         CI,5     79                IS IT TOO LONG
         BLE      %+2               NOPE
         LI,5     79                TRUNCATE AT 79 CHARS.
         STB,5    *3                REPLACE CMD PTR IN FPT.....
         LB,13    *12,5             ... WITH COMMAND STRING
         STB,13   *3,5
         BDR,5    %-2               COPY NEXT CHARACTER
LNK8     EQU      %
*D*
*D*               THE 'RELCORE' SUBROUTINE IS CALLED TO RELEASE ANY
*D*               ASSOCIATED PROCESSORS, TO RELEASE ALL USER CORE EXCEPT
*D*               COMMON PAGES, AND TO RESET THE JIT MEMORY DELIMETERS.
*D*               CONTROL THEN TRANSFERS TO THE 'L10LNK' SUBROUTINE TO
*D*               SET UP AN EXIT ENVIRONMENT AND DRIVE TO T:ASP IN THE
*D*               STEP OVERLAY TO LOAD AND ENTER THE REQUESTED PROGRAM.
*D*
LNK7RLCO BAL,10   RELCORE           RELEASE PROCS & CORE
         B        L10LNK            GET LOAD MODULE & GO
         PAGE
*F*
*F*      NAME:    LDT0
*F*
*F*      PURPOSE: TO PROCESS THE M:LDTRC CAL.
*F*
*F*      DESCRIPTION:  THE IDN FILE IS SEARCHED FOR A SET OF RECORDS
*F*               WHOSE HEAD RECORD MATCHES THE NAME SPECIFIED ON
*F*               THE M:LDTRC CAL.  IF NOT FOUND THE CAL DID NOT
*F*               SPECIFY A PROGRAM PREVIOUSLY SAVED VIA AN M:LINK CAL
*F*               AND CONTROL TRANSFERS TO THE ASSOCIATE PROGRAM LOGIC
*F*               IN THE STEPOVR OVERLAY TO ASSOCIATE AND ENTER THE
*F*               SPECIFIED PROGRAM.
*F*
*F*               OTHERWISE, THE PROGRAM IS RESTORED FROM THE IDN FILE
*F*               AND THE RESTORED SET OF RECORDS ARE DELETED FROM THE
*F*               FILE.  THE PSD FOR THE PROGRAM BEING RESTORED IS
*F*               PLACED IN THE USER ENVIRONMENT IN TSTACK.  IF A
*F*               SHARED PROCESSOR MUST BE RESTORED CONTROL TRANSFERS
*F*               TO T:ASP IN THE STPOVER OVERLAY TO REASSOCIATE THE
*F*               SHARED PROCESSORS PROCEDURE.  OTHERWISE CONTROL
*F*               RETURNS TO THE RESTORED USER PROGRAM AT THE M:LINK
*F*               CAL+1.
*F*
         PAGE
*D*      NAME:    LDT0
*D*
*D*      INPUT:   R6 = 1ST WORD OF PLIST IN FPT
*D*               R7 = ADDRESS OF PLIST+1 IN FPT
*D*
*D*      DESCRIPTION:  LDT0 CALLS 'TRUNK' WHICH TRUNCATES THE USER'S DCBS,
*D*               CALLS 'VALID' WHICH INSURES IT IS LEGAL TO PERFORM
*D*               THE M:LDTRC CAL, AND CALLS 'MOVEFPT' WHICH OBTAINS A
*D*               BUFFER AND MOVES THE USER'S ENVIRONMENT AND THE
*D*               M:LDTRC FPT TO IT.
LDT0     EQU      %
         BAL,11   TRUNK
         BAL,5    VALID
         BAL,5    MOVEFPT
*D*
*D*               THE FOLLOWING JIT VALUES ARE SET TO ZERO:
*D*                  J:INTENT  BREAK CONTROL ROUTINE ADDRESS
*D*                  J:TIMENT  M:STIMER ROUTINE ADDRESS
*D*                  J:UTIMER  TIME INTERVAL SPECIFIED ON M:STIMER
*D*                  J:USENT   TRAP CONTROL ROUTINE ADDRESS
*D*
LDT03    EQU      %
         LI,4     0
         STW,4    J:INTENT
         STW,4    J:TIMENT
         STW,4    J:UTIMER
         STW,4    J:USENT
*D*               SET UP THE CAL3 TRAP VECTOR, J:ALB
         LI,4     CAL3PSD
         STW,4    J:ALB             CAL3'S TO ABORT.
*D*
*D*               M:XX IS CLOSED, IF OPEN.  THE 'CLOSE' SUBROUTINE
*D*               IS CALLED TO CLOSE ALL USER DCBS.
*D*
         BAL,11   CLOSE
*D*
*D*               THE 'RELCORE' SUBROUTINE IS CALLED TO RELEASE ANY
*D*               ASSOCIATED PROCESSORS, TO RELEASE ALL USER CORE EXCEPT
*D*               COMMON PAGES, AND TO RESET THE JIT MEMORY DELIMETERS.
*D*
         BAL,10   RELCORE           REL PROCS & CORE
         LW,13    *TSTACK           POINTER TO NAME
*D*
*D*               IF THE REQUESTED PROGRAM NAME IS NOT IN THE FORM
*D*               'IDN' CONTROL TRANSFERS TO THE 'LNK10' ROUTINE TO
*D*               SET UP THE FILE NAME IN AN EXIT ENVIRONMENT AND GO
*D*               TO T:ASP IN THE STEP OVERLAY WHICH GETS THE REQUESTED
*D*               PROGRAM.
*D*
         LB,2     *13               BYTE CNT OF NAME
         CI,2     3
         BNE      L10LNK2           NOT SAME AS IDN NAME
         LW,2     *13
         SLS,2    -8                STRIP OFF N
         AND,2    XFFFF             ID OF REQUESTED NAME
         LI,3     X'FFFF'
         CS,2     J:JIT             IS ID IN NAME SAME AS THIS JOB'S
         BNE      L10LNK2           NO
         LI,3     X'FF'             MASK FOR RIGHTMOST BYTE
         AND,3    *13               GET LAST BYTE OF FILENAME
         CI,3     'B'               IS IT A REAL STAR FILE (*L)?
         BGE      L10LNK2           IF SO, PROCESS AS USUAL.
*D*
*D*               OTHERWISE, THE REQUEST IS FOR A PREVIOUSLY SAVED
*D*               PROGRAM.  THE 'IDN' FILE IS OPENED IN THE UPDATE MODE
*D*               AND POSITIONED TO THE END OF!FILE.
*D*
         LI,9     1
         STW,9    M:XX
         LCI      11
         LM,0     OPNFPT
         LW,9     *13               GET LMN INTO FPT
         AND,9    YFFFFFF
         AI,9     'N'               MAKE IT IDN
         LW,11    Y4                SET ACCESS CTL FLAG
         STS,11   J:STAR+5
         LCI      2
         LM,11    J:ACCN            GET ACCN FROM JIT
         LW,13    PSINDIC
         LI,6     4                 MODE - UPDATE
         CAL1,1   0                 OPEN FPT IN REGS 0 THRU 9
*                                   ERROR RETURN IS ABORT
         LCI      2
         LM,0     PFILE
         CAL1,1   0                 GO TO EOF
*D*
*D*               THE RECORDS IN THE FILE ARE READ REVERSE UNTIL THE
*D*               CORRECT SET OF RECORDS ARE FOUND.
*D*
         LW,3     TSTACK
         LW,2     0,3               POINTER TO NAME
         LW,2     0,2               ID NAME
         LI,7     X'FF'
         LS,6     J:RNST            CHECK IF RETURNING TO CURRENT LINK
         AI,6     -1                LEVEL -1. IF SO SET LINK LEVEL
         CS,6     2                 CORRECTLY.
         BNE      %+2
         STS,6    J:RNST
         LI,1     0                 SET FLAG FOR
         STW,R1   SBUF1VPA+FLAGDISP  ANY FILES LEFT
LP       BBLC     1                 FAKE BFR CHKR
         LI,R0    SBUF1VPA+IDNDISP
         LI,1     8                 2 WORDS
         CAL1,1   READR             READ REVERSE
         LW,R1    SBUF1VPA+NRECDISP
         BNEZ     PR
         MTW,1    SBUF1VPA+FLAGDISP CAN'T RELEASE IDN
         B        LP
PR       LCI      4
         LM,3     PREC              POSITION REVERSE
         CAL1,1   3                 # OF RECORDS IN R1
         CW,R2    SBUF1VPA+IDNDISP  CHECK FOR MATCH
         BNE      LP                NOPE, TRY AGAIN
*WE FOUND THE CORRECT SET OF RECORDS
         LI,1     1
         LCI      4                 POSITION REVERSE 1 RECORD
         LM,3     PREC              SO WE ARE SET TO READ HEADER
         CAL1,1   3
PR2      LI,R0    SBUF1VPA+IDNDISP
         BBLC     1
         LI,1     8                 2 WORDS
         CAL1,1   READ              READ HEADER
*E*
*E*      ERROR    B5-6F
*E*      MESSAGE: LDTRC TO PREVIOUSLY EXECUTED FILE.
*E*
         LI,10    X'6F'             B5-6F ERROR CODE
         SCS,10   -8                IN THE PROPER FASHION
         CW,R2    SBUF1VPA+IDNDISP
         BNE      RDERR
         LW,R0    SBUF1VPA+NRECDISP
         BNEZ     RDERR
         LCI      2
         LM,0     DELREC
         CAL1,1   0                 DON'T READ AGAIN
*D*
*D*               THE JIT INFORMATION RECORD IS READ INTO THE BUFFER AND
*D*               THE JIT VALUES RESTORED AFTER CHECKING THE VALUES
*D*               OBTAINED TO MAKE SURE THEY ARE REASONABLE.
*D*
         LI,0     SBUF1VPA          BUFFER ADDRESS
         LI,1     JINFOSZ+CCBSIZ    SIZE FOR READ
         BBLC     3
         CAL1,1   READ
*  RESTORE SPECIAL JIT VALUES
         LCI      10
         LM,6     SBUF1VPA+BUPDISP  6-15 = BUP-DCBUL
* CHECK TO MAKE SURE TRANSFER FILE IS GOOD
         LW,1     9                 PUL
         SW,1     8                 PLL
         AW,1     11                DUL
         SW,1     10                DLL
         AW,1     15                DCBUL
         SW,1     14                DCBLL
         AW,1     13                DDUL
         SW,1     12                DDLL
         AI,1     4                 LIMITS ARE INCLUSIVE
         BLZ      ILLEGAL           TOO SMALL
         AW,1     6                 BUP+PROGRAM SIZE
         AI,1     -1                -1 TO GET EUP
         CW,1     7                  :EUP
         BG       ILLEGAL           TOO BIG
         LI,1     1                 DOES DYNAMIC DATA OVERLAP WITH
         LB,1     JB:BCP,1            COMMON PAGES
         AI,1     1                 GET THE LAST PAGE ALLOCATED
         CW,1     SBUF1VPA+TDPDISP
         BL       NOCORE2           CURRENT BCP < RESTORING TDP
* OK SO FAR-RESTORE JIT MEMORY DELIMITERS
         LCI      8
         STM,6    J:BUP
         STD,14   J:DCBLL
* GET SPECIAL JIT VALUES
         LW,6     S:CUN
         LW,7     SBUF1VPA+FLGDISP
         STH,7    UH:FLG,6
         LCI      6
         LM,8     SBUF1VPA+INTEDISP GET VALUES FROM BUFFER
         STW,8    J:INTENT
         STW,9    J:TIMENT
         STW,10   J:UTIMER
         STW,11   J:USENT
         LI,7     J:DLL             TCB = 1ST WORD OF DATA IF EXISTS
         LW,11    Y04               * GET EXLY MASK BIT
         LS,10    13                * AND FETCH CORR. BIT FROM J:TREE WD.
         STS,10   J:EXLY            * RESTORE BIT TO ITS RIGHTFUL VAL.
         AND,13   X1FFFF            * CLOBBER WHATEVER I MIGHT HAVE SAVED
         LW,8     12
         BEZ      %+2
         BAL,11   CHECKVAL
         STW,12   J:TCB
         LI,7     J:PLL             TREE = 1ST WORD OF PP
         LW,8     13
         BEZ      %+2
         BAL,11   CHECKVAL
         STW,13   J:TREE
*D*
*D* J:CCBUF IS THEN RESTORED IF NECESSARY.
*D*
         LW,1     J:RNST
         CW,1     Y008              IS CCBEF SET
         BAZ      LDT2A             NO-SO RESTORE CCBUF
         SLS,1    13
         LC       1
         BCS,2    LDT2B             B IF CCSTAT SET-DONT RESTORE
         BCR,3    LDT2B             B IF CCSTAT,CCSTAT2 RESET
LDT2A    EQU      %
         LD,8     GETCCBUF          GET MBS PARAMS
         MBS,8    0                 RESTORE J:CCBUF
         LB,8     SBUF1VPA+SYMTABDISP   GET SAVED JB:CCARS
         STB,6    JB:CCARS          AND PUT IT BACK
LDT2B    EQU      %
         LW,9     Y004              MASK FOR PCCF
         LI,8     0
         STS,8    J:RNST            RESET PCCF
*D*      RESTORE CAL3 VECTOR INFORMATION FROM THE JIT RECORD
         LCI      3
         LM,7     SBUF1VPA+C3VDISP  GET THE WORDS
         STW,7    J:ALB             VECTOR ADDRESS
         STD,8    J:XPSD+2          USER ENTRY PSD
*D*
*D*      RESTORE J:UPRIV
*D*
         LW,7     SBUF1VPA+UPRVDISP GET SAVED J:UPRIV
         STW,7    J:UPRIV           AND PUT IT BACK
*D*
*D*      HERE WE MOVE THE SAVED VALUE OF UB:APR INTO THE REAL
*D*      UB:APR ENTRY FOR THIS USER, SO THAT T:GNVPI AND
*D*      T:TOTESZ IN MM KNOW THAT THERE'S A SHARED PROCESSOR
*D*      ASSOCIATED WITH THIS GUY, AND DON'T TRY TO CHARGE
*D*      HIM FOR THE PROCESSOR PROCEDURE PAGES.
*D*
         LB,7     SBUF1VPA+PRFLDISP GET UB:APR
         LW,2     S:CUN             GET USER ID
         STB,7    UB:APR,2          SAVE UB:APR FOR MM'S USE
*D*
*D*               IF THERE IS A DCB RECORD, THE PAGES ARE OBTAINED
*D*               AND THE DCBS ARE RESTORED.
*D*
         LW,7     J:DCBLL           BUFFER FOR DCBS
         LW,6     SBUF1VPA+DCBSDISP # PAGES OF DCBS
         BEZ      LDT3
         LI,1     -8
         STB,6    *TSTACK,1         SAVE # OF DCB PGS
         BAL,11   T:GNVPI
         BCS,15   EB500             OUT OF USER'S CORE
         LW,0     J:DCBLL
         LW,1     6
         BAL,4    READCAL
*D*
*D*               IF THERE IS A DATA RECORD, THE PAGES ARE OBTAINED AND
*D*               THE DATA IS RESTORED.
*D*
LDT3     LW,7     J:DLL             BUFFER FOR DATA
         LW,6     SBUF1VPA+DSZDISP  # PAGES OF DATA
         BEZ      LDT35
         LW,2     J:DUL
         BAL,11   MEMSET            GET THE PAGES
         LW,1     SBUF1VPA+DSZDISP  SIZE
         LW,0     J:DLL
         BAL,4    READCAL
*D*
*D*               IF THERE IS A PROCEDURE RECORD, THE PAGES ARE
*D*               OBTAINED AND THE PROCEDURE IS RESTORED.
*D*
LDT35    EQU      %
         LW,8     SBUF1VPA+PRFLDISP GET PROCESSOR WORD
         LB,9     8                 GET APR
         LW,6     SBUF1VPA+PRSZDISP
         BEZ      LDT36
         LW,7     J:PLL
         LW,2     J:PUL
         BAL,11   MEMSET
         LW,0     J:PLL
         LW,1     SBUF1VPA+PRSZDISP
         LW,11    Y2                SET THE PP SWAP FLAG
         STS,11   J:ASSIGN           WHILE READING PROCEDURE
         BAL,4    READCAL
         LI,10    0                 RESET PP SWAP
         STS,10   J:ASSIGN
*D*
*D*               IF THERE IS ANY DYNAMIC DATA, THE PAGES ARE OBTAINED
*D*               AND THE DYNAMIC DATA IS RESTORED.
*D*
LDT36    LW,6     SBUF1VPA+DDSDISP
         BEZ      LDT37
         LW,7     J:DDLL
         BAL,11   T:GNVPI
         BCS,15   EB500
         LW,0     J:DDLL
         LW,1     6
         BAL,4    READCAL
*D*
*D*               PAGES FOR THE SYMBOL TABLE ARE OBTAINED AND THE
*D*               SYMBOL TABLE IS RESTORED, IF IT EXISTS.
*D*
LDT37    LW,6     SBUF1VPA+STSZDISP
         BEZ      LDT38
         LW,7     SBUF1VPA+SYMTABDISP
         AND,7    MASKS+24          DON'T CONFUSE MM
         BAL,11   T:GNVPI
         BCS,15   EB500
         LW,0     SBUF1VPA+SYMTABDISP
         AND,0    MASKS+24          REMOVE JB:CCARS FROM HIGH BYTE
         LW,1     6
         BAL,4    READCAL
*D*
*D*               IF DELTA WAS ASSOCIATED, DELTA'S DATA PAGE IS
*D*               OBTAINED AND THE PAGE IS RESTORED.
*D*
LDT38    LI,4     X'FF00'
         AND,4    8                 WAS DELTA ASSOCIATED
         BEZ      LDT65             NO
         LI,7     JSPVP             YES-GET DELTA'S DATA PAGE
         LI,6     1
         BAL,11   T:GNVPI
         BCS,15   EB500
         BBLC     1                 FAKE BUFFER CHECK
         LI,0     SPDBASE           PAGE ADDRESS
         LI,1     512*4             BYTE SIZE
         CAL1,1   READ              RESTORE IT
*  RESTORE NEXT AVAILABLE DYN PG VALUE
LDT65             EQU              %
         LW,10    SBUF1VPA+TDPDISP  GET TOP DYN PAGE
         STB,10   JB:TDP            & PUT INTO JIT
*  RESTORE EXIT CONTROL ADDRESS
         LW,6     SBUF1VPA+XITDISP
         STW,6    J:EXTENT
* RESTORE PROCESSOR/USER FLAG
         LW,6     SBUF1VPA+PRUSDISP
         LW,7     Y003E
         STS,6    J:RNST
         LB,6     6
         LI,7     X'FF'
         STS,6    JB:PROMPT
*D*
*D*               AT THIS POINT ALL OF THE USER'S PROGRAM HAS BEEN
*D*               RESTORED.  THE 'IDN' FILE IS CLOSED.  SAVE IS SPECIFIED
*D*               IF THERE ARE NO OTHER RECORDS BUILT FOR M:LINK IN THE
*D*               FILE.  RELEASE IS SPECIFIED IF THIS WAS THE ONLY
*D*               SET OF RECORDS IN THE FILE.
*D*               THE TEMPORARY VALUE THAT WAS STORED IN UB:APR EARLIER
*D*               IS NOW CLEARED TO AVOID CONFUSING T:ASP.
*D*
         LI,1     0
         LW,2     S:CUN
         STB,1    UB:APR,2
         LI,6     M:XX
         LCI      3
         LM,0     CLOSEWD0
         LW,R10   SBUF1VPA+FLAGDISP ANY FILES LEFT?
         BNEZ     LDT7              YES, DON'T RELEASE
         LI,10    X'FF'             DID WE GET TO 1ST
         AND,R10  SBUF1VPA+IDNDISP
         BNEZ     LDT7              NOPE
         LI,11    X'FF'             RESET COUNTER
         STS,10   J:RNST
         LI,2     1                 REL
LDT7     CAL1,1   0                 CLOSE IDN
* RESTORE M:XX NAME/ACCT/PASSWORD
         LCI      11
         LM,10    MXXDISP+SBUF1VPA
         STM,10   M:XX+23
*D*
*D*               THE USER'S PSD IS MOVED FROM THE JIT INFORMATION
*D*               RECORD TO THE USER'S ENVIRONMENT.
*D*
         LCI      2
         LM,10    SBUF1VPA+PSDDISP  GET USER PSD FROM BUFFER
         OR,10    Y008              FORCE SLAVE MODE
         STD,R10  SBUF1VPA+UPDSDISP PSD TO USER ENVIRONMENT
         LI,11    X'6000'
         LS,R10   SBUF1VPA+PSD1DISP GET SAVED IMPLICIT RETURN BITS
         STS,10   J:RNST            AND RESTORE 'EM TO THE JIT
*D*
*D*               IF A CORE LIBRARY AND/OR DELTA IS TO BE ASSOCIATED
*D*               THE APPROPRIATE PROCESSOR USE COUNTS ARE INCREMENTED
*D*               AND THE USER IS REG'ED TO GET THE SPECIAL SHARED
*D*               PROCESSOR PROCEDURE IN CMAP.
*D*
         LW,4     S:CUN
         LH,15    UH:FLG,4
         LI,6     X'FF00'           GET DEBUGGER (IF ANY)
         AND,6    8
         SLS,6    -8
         LI,5     X'FF'             GET LIBRARY (IF ANY)
         AND,5    8
         BNEZ     LDT75             ASSOCIATE LIBRARY FIRST
         LW,2     9                 NO LIBRARY-IS THERE APR
         BNEZ     LDT85             YES-CANT BE A DEBUGGER
         LW,6     6                 IS THERE A DEBUGGER
         BEZ      LDT9              NO-NO SHARED PROCESSORS
LDT75    STB,6    UB:DB,4           RESTORE DEBUGGER # (OR 0)
         STB,5    UB:ASP,4          RESTORE LIBRARY # (OR 0)
         LI,7     0                 PHONEY PAGE #
         BAL,0    T:TOTESZ          FIND SIZE INCLUDING ASP/DB
         B        NOCORE            TOO BIG
         LW,2     9                 IS THERE APR WITH ASP
         BNEZ     LDT85             YES-GO GET IT
*                                     (STEP WILL REG TO GET LIB PROCEDURE)
         LW,6     6                 IS THERE A DEBUGGER
         BEZ      LDT76             NO
         OR,15    X400              SET DELA
         LW,5     5                 IS THERE ASP WITH DEBUGGER
         BNEZ     %+2               YES-DONT BUMP DELTAS UC
         MTB,1    PB:UC,6           NO-BUMP IT
LDT76    MTB,1    PB:UC,5           INCREMENT LIBRARY UC
         AND,15   XFFFE             RESET READY TO RUN
         STH,15   UH:FLG,4
*                                   REG TO GET SP. SHARED PROC, IN CMAP
         LI,6     E:AP
         BAL,11   T:REG
         BAL,11   T:PAC
         B        LDT9
*D*
*D*               IF A STANDARD SHARED PROCESSOR IS BEING RESTORED, BIT
*D*               0 IN J:CFLAGS IS SET TO SIGNAL T:ASP THAT A PROCESSOR
*D*               IS BEING RESTORED.  THE CORRECT OVERLAY TO BE ASSOCIATED
*D*               IS SET IN BYTE 1 OF J:CFLAGS.
*D*               CONTROL THEN TRANSFERS TO THE 'L10LNK' SUBROUTINE TO
*D*               SET UP AN EXIT ENVIRONMENT AND DRIVE TO T:ASP IN THE
*D*               STEP OVERLAY TO LOAD AND ENTER THE RESTORED PROCESSOR.
*D*
LDT85    EQU      %
         LD,6     P:NAME,2
         LW,13    SYSACT            SYS ACCT #
         LW,14    SYSACT+1
         LI,10    0                 NO PASSWD
         LI,11    0
         MTW,1    SBUF1VPA+UPDSDISP BUMP USER'S PSD
         LI,2     1
         LB,1     8,2               GET APO FROM REG 8
         STB,1    J:CFLGS,2         APO OR 0 TO BYTE 1
         LW,2     Y8
         LW,3     YC
         STS,2    J:CFLGS
         PULL     2,4
         B        L14               SET UP TEMP STACK & GO TO ASP
*D*
*D*               IF A USER PROGRAM IS BEING RESTORED, THE DCB CHECKER
*D*               IN THE STEP OVERLAY IS CALLED.
*D*
LDT9     EQU      %
         LI,12    LDT95
         LI,1     -8
         LB,1     *TSTACK,1         # OF DCB PGS
CKDCBS   EQU      %
         LW,0     J:DCBLL
         SLD,0    9
         CI,1     0
         BEZ      *12               NO DCBS
         STW,0    J:DCBLINK
         PUSH     16,2              SAVE ALL REGS
         LI,14    SBUF2VPA          BUFFER TO USE
         BAL,2    T:GBUF            GET THE BUFFER
         PULL     2,0               RESTORE 0 AND 1
         LW,2     0                 BEG OF DCBS
         LI,4     SBUF2VPA          BUFFER TO USE
         LI,5     -1
         PUSH     0                 REGS PULLED BY STEPOVRSEG
         PUSH     2
         OVERLAY  STEPOVRSEG,DCBCHK#
         LI,14    SBUF2VPA          BUFFER TO RELEASE
         LI,5     0
         BAL,2    T:RBUF            RELEASE THE BUFFER
         LW,1     6                 CC TO R1
         BEZ      %+3               NO ERRORS
         LI,0     0
         STW,0    J:DCBLINK
         PULL     14,2              RESTORE 2 THRU 15
         SCS,1    -8                POSITION ERROR CODE
         LC       1                 SET CC
         B        *12
*D*
*D*               THE 'RELBUF' SUBROUTINE IS CALLED TO MOVE THE USER'S
*D*               ENVIRONMENT FROM THE JIT INFORMATION RECORD INTO
*D*               TSTACK AND RELEASE THE BUFFER THAT WAS USED TO READ
*D*               THE JIT INFORMATION RECORD.  THE LNKTRC OVERLAY IS
*D*               EXITED AND CONTROL RETURNS TO THE RESTORED PROGRAM
*D*               AT THE M:LINK CAL+1.
*D*
LDT95    BCS,3    ILLEGAL           BAD DCB'S
         PULL     2,2               BUMP STACK -2
         PULL     11
         BAL,5    RELBUF
         LW,4     TSTACK
         LW,5     J:TCB
         STW,5    -15,4
         DESTRUCT
         PAGE
*F*
*F*      NAME:    L10LNK
*F*
*F*      PURPOSE: TO SET UP THE EXIT ENVIRONMENT AND DRIVE TO T:ASP TO
*F*               LOAD AND ENTER THE REQUESTED LOAD MODULE.
*F*
*F*      DESCRIPTION:  THE REGISTERS AT THE TIME OF THE M:LINK/M:LDTRC
*F*               ARE MOVED TO THE USER'S ENVIRONMENT.  A SECOND ENVIRON-
*F*               MENT CONTAINING THE INTERPRETIVE EXIT FOR THE REQUESTED
*F*               LOAD MODULE IS BUMPED INTO TSTACK AND CONTROL TRANSFERS
*F*               TO T:ASP IN THE STEP OVERLAY.
*F*
*D*
*D*      NAME:    L10LNK,L10LNK2
*D*
*D*      DESCRIPTION:  BIT 1 OF J:CFLAGS IS SET TO INDICATE WE ARE
*D*               ASSOCIATING A NEW PROGRAM RATHER THAN RESTORING
*D*               A SHARED PROCESSOR. R12 IS SET TO INDICATE IF
*D*               WE ARE PERFORMING AN M:LINK (R12=1) OR
*D*               M:LDTRC (R12=0).
*D*
L10LNK2  EQU      %
         LI,12    0                 SET TO INDICATE M:LDTRC
         B        L10
L10LNK   EQU      %
         LI,12    1                 SET TO INDICATE M:LINK
L10      EQU      %
         LW,2     Y4
         LW,3     YC
         STS,2    J:CFLGS           SET BIT 0 OR 1
         PULL     2,4               4=1ST WD OF FPT  5=ADR OF FPT+1
         LW,9     5                 COPY PTR TO FPT+1 FOR GETREG
*D*
*D*               THE PROGRAM NAME SPECIFIED IN THE USER'S FPT IS
*D*               LOADED INTO R6-R8.
*D*
         LD,6     BLANKS            TRAILING BLANKS IN 1ST DBLWD
         LB,3     *5                CHAR CNT OF LMN
         CI,3     11
         BLE      %+2
         LI,3     11                TRUNCATE AT 11 CHARS
         LW,1     3                 COPY COUNT
         SLS,1    -2
         AI,1     1                 GET # OF WORDS
         STB,3    6
         LB,2     *5,3              MOVE LMN TO R6-R8
         STB,2    6,3
         BDR,3    %-2
         AW,5     1                 POINT TO WD AFTER NAME
*D*
*D*               THE ACCOUNT SPECIFIED IN THE USER'S FPT IS LOADED
*D*               INTO R13-R14.
*D*
         LCI      2
         LM,13    J:ACCN            GET ACCT# FROM JIT IN CASE NONE SPEC
         CI,4     2                 IS THERE AN ACCT
         BAZ      L11               NO
         LW,13    0,5               GET
         LW,14    1,5                   ACCT
         AI,5     2                 IF ACCT, POINT TO PASSWD
L11      EQU      %
*D*
*D*               WE THEN CHECK FOR AN M:LINK TO A COMMAND
*D*               PROCESSOR AND ABORT THE USER IF THIS IS THE CASE.
*D*
         CI,12    0
         BE       L11A              B IF M:LDTRC
         CW,13    SYSACT            IS ACCOUNT :SYS?
         BNE      L11A              NOPE
         CW,14    SYSACT+1          CHECK LAST WORD TOO
         BNE      L11A              DOESN'T MATCH
         LI,2     PNAMEND
         CD,6     P:NAME,2          FIND IN PROCESSOR TABLES
         BE       %+3               GOT IT
         BDR,2    %-2
         B        L11A              NOT THERE
         LW,3     P:SA,2            GET PROCESSOR FLAGS
         CW,3     Y07               IS IT A COMMAND PROC.?
         BAZ      L11A              NOPE
         LI,10    0
         LW,11    Y4
         STS,10   J:CFLGS           RESET TO AVOID NEG. USE CNT
*E*      ERROR:   B5-6A
*E*      DESCRIPTION: M:LINK TO SHARED PROCESSOR NOT ALLOWED
         LI,10    X'A'              ERROR SUBCODE =X'6A'
         B        INVALID           REPORT ERROR
L11A     EQU      %
*D*
*D*               THE PASSWORD SPECIFIED IN THE FPT IS LOADED
*D*               INTO R10-R11.
*D*
         LI,10    0
         LI,11    0
         CI,4     1
         BAZ      L12
         LW,10    0,5               GET
         LW,11    1,5                   PASSWD
         AI,5     2                 IF PASSWD, POINT TO CMD PTR.
L12      EQU      %
*  GET ADDR OF CMD STRING INTO R12
         CI,12    0                 IS THIS AN M:LDTRC
         BE       L14               YES-SO SKIP PASSING COMMAND
         CI,4     X'04'             WAS (CMD) SPECIFIED?
         BAZ      L14               NO - SKIP PASSING COMMAND
         LI,12    6                 POINT TO "LMN" IN R6
         CI,4     X'20'             "LMN" OVERRIDE BIT SET?
         BANZ     L13               YES - IGNORE STRING ADDRESS
         LW,12    5                 COPY PTR TO CMD STR IN FPT
*D*
*D* THE COMMAND STRING, IF ANY, IS THEN MOVED TO J:CCBUF.
*D*
L13      EQU      %
         LB,5     *12               GET CHAR CNT OF CMD
         BNEZ     %+3               COUNT OK
         LI,12    6                 PASS LMN FOR NULL CMD
         LB,5     *12
         CI,5     79                MAKE SURE CMMND IS NOT TOO LONG
         BLE      %+2
         LI,5     79                TRUNC IT IF IT IS.
         LW,1     5                 COPY COUNT
         SCS,5    -8
         AI,5     BA(J:CCBUF)
         LC       J:JIT
         BCS,8    %+2               B IF ONLINE
         AI,5     1                 OFFSET BY 1 BYTE IF BATCH
         LW,4     12                COPY CMD STRING PTR
         SLS,4    2                 MAKE BYTE ADDR
         AI,4     1                 DONT MOVE TEXTC COUNT BYTE
         MBS,4    0
         LC       J:JIT
         BCS,8    L14A              DONE IF ONLINE
         AI,1     1                 ADJUST FOR BLANK IN BYTE 0
         LI,4     80
         SW,4     1                 # OF BYTES TO BLANK FILL
         STB,4    1                 SAVE AS COUNT FOR MBS,0
         AI,1     BA(J:CCBUF)
         LI,0     X'40'
         STB,0    J:CCBUF           BYTE ZERO IS BLANK
         MBS,0    3                 BLANK FILL REST OF J:CCBUF
         B        L14
L14A     EQU      %
         LI,4     X'0D'
         STB,4    J:CCBUF,1         INSERT FINAL CARRIAGE RETURN
         AI,1     1                 ADD 1 FOR APPENDED CR
         STB,1    JB:CCARS          PASS COUNT IN JB:CCARS
L14      EQU      %
         LD,R0    SBUF1VPA+DBUGDISP GET DEBUGGER NAME (OR ZEROES)
*D*
*D*               THE 'RELBUF' SUBROUTINE IS CALLED TO MOVE THE CALLING
*D*               PROGRAMS ENVIRONMENT FROM THE BUFFER BACK TO TSTACK.
*D*               THIS ALLOWS INTER-PROGRAM COMMUNICATION VIA THE
*D*               REGISTERS.  'RELBUF' WILL ALSO RELEASE THE BUFFER.
*D*
         PULL     4                 PULL EXIT ADR - NOT NEEDED
         BAL,5    RELBUF
*D*
*D*               A  SECOND ENVIRONMENT IS BUMPED INTO TSTACK.  THIS
*D*               ENVIRONMENT IS TO BE USED AS AN INTERPRETIVE EXIT
*D*               ENVIRONMENT WHEN CALLING T:ASP.  THE NAME, ACCOUNT
*D*               AND PASSWORD OF THE REQUESTED PROGRAM IS SET INTO
*D*               THIS ENVIRONMENT.
*D*               REGISTERS IN: R6-R8  = PROGRAM NAME TEXTC.
*D*                             R10-R11= PROGRAM PASSWORD.
*D*                             R13-R14= PROGRAM ACCOUNT.
*D*                             R0-R1  = DEBUGGER OR ZERO.
         LI,9     0                 ASP FLAG: MUST BE LM, NOT CF.
         BUMP     3,4
         PUSH     16,0              BUILD 19-WORD ENVIRONMENT FOR ASP.
*D*
*D*               ALL CURRENTLY ALLOCATED FILE MANAGEMENT BUFFERS
*D*               ARE RELEASED AND CONTROL TRANSFERS TO T:ASP IN
*D*               THE STEP OVERLAY.
*D*
         PUSH     16,0
         BAL,6    T:ZBUF
         PULL     16,0
*D*
*D*               RESET SJAC
*D*
         LW,3     S:CUN
         LH,2     UH:FLG,3
         AND,2    XEFFF
         STH,2    UH:FLG,3
         LI,2     0
         LW,3     Y003E
         STS,2    J:RNST
         LI,11    T:ASP
         B        T:SELFDESTRUCT
         SPACE    2
*  CHECK TO MAKE SURE THAT THE COMMAND-STRING ADDRESS IS OK
ADDRCHK  CI,12    X'1FFF0'          OK IF IT'S A REGISTER
         BAZ      *13
         LW,5     12                COPY THE ADDRESS
         SLS,5    -9                MAKE IT A PAGE NUMBER
         LOAD,5   JX:CMAP,5         GET ASSIGNED PAGE #
         CI,5     FPMC              IS IT AN UNASSIGNED PAGE?
         BNE      *13               IF NOT LET'S ASSUME IT'S OK
         LI,10    X'4A'
         B        INVALID+1         GO KILL THIS USER
*E*      ERROR:   B5-4A
*E*      MESSAGE: COMMAND STRING ADDRESS DOESN'T BELONG TO THE USER
         SPACE    2
*  IF PASSED REG ADDR., RETURN POINTER INTO BUFFER
GETREG   EQU      %
         CI,12    X'1FFF0'
         BANZ     *5
         AW,12    9                 ADD PTR TO WD 1 OF FPT IN BUFR
         AI,12    -17               DISP TO USERS R0 IN BUFFER
         B        *5
         PAGE
*F*
*F*      NAME:    LEXIT
*F*
*F*      PURPOSE: TO CLEANUP THE IDN TEMPORARY FILE AS PART OF
*F*               USER RE-INITIALIZATION.
*F*
*F*      DESCRIPTION:  AT EXIT TIME, THE STEPOVR OVERLAY RECOGNIZES
*F*               THAT M:LINK CALS HAVE BEEN ISSUED AND CALLS LNKTRC
*F*               FOR CLEAN-UP.
*F*
*F*               THE IDN FILE IS SEARCHED FOR EACH SET OF RECORDS THAT
*F*               WAS BUILT AS A RESULT OF AN M:LINK CAL.  THE FILE WILL
*F*               CONSIST ONLY OF RECORDS FOR PROGRAMS THAT ISSUED AN
*F*               M:LINK AND WAS NOT RE-ENTERED VIA M:LDTRC.
*F*
*F*               FOR EACH SUCH SET OF RECORDS, THE JIT BUFFER INFORMATION
*F*               AND THE DCB PAGES ARE RESTORED.  ALL DCBS THAT WERE
*F*               LEFT OPEN AT THE TIME OF THE M:LINK ARE CLOSED.
*F*
*F*               THE TEMPORARY FILE 'IDN' IS RELEASED AND CONTROL
*F*               RETURNS TO THE STEPOVR OVERLAY.
*F*
*D*      NAME:    LEXIT
*D*
*D*      DESCRIPTION:  BYTE 0 OF J:RNST IS SET TO ZERO TO INDICATE
*D*               NORMAL EXECUTION.
*D*
LEXIT    EQU      %
         LI,8     0
         LI,9     X'6000'
         STS,8    J:RNST            RESET IMPLICIT RETURN FLAGS
         PUSH     11                SAVE RETURN
         PUSH     2,6               SAVE WD1 OF FPT, PTR TO FPT+1
         LB,10    J:RNST
         PUSH     10                SAVE BYTE 0 OF RNST
         STB,8    J:RNST            AND ZERO IT.
*D*
*D*               SPECIAL BUFFER 1 IS OBTAINED TO BE USED FOR
*D*               READING THE JIT INFORMATION RECORD.
*D*
         LI,14    SBUF1VPA
         BAL,2    T:GBUF
         LW,5     Y2
         STS,5    J:CFLGS           SET BUF1 IN USE FLAG
*D*
*D*               THE ERROR CODE IN J:ERO IS SAVED IN THE BUFFER
*D*               AS J:ERO WILL BE DESTROYED BY THE ERROR RETURN USED
*D*               FOR M:XX.
*D*
         LW,4     JIT+ERO
         STW,R4   SBUF1VPA+ERODISP
*D*
*D*               IF M:XX IS OPEN, IT IS CLOSED.
*D*
         LI,4     M:XX
         LCI      3
         LM,0     SHUTDCB
         LW,5     Y002
         CS,5     M:XX              IS IT OPEN
         BNE      %+2               NO
         CAL1,1   0
*D*
*D*               THE 'IDN' FILE IS OPENED IN THE UPDATE MODE.
*D*
         LI,9     1
         STW,9    M:XX
         LW,9     J:JIT
         AND,9    XFFFF
         SLS,9    8
         OR,9     Y03
         LI,12    0
         STW,12   J:DCBLINK
         LI,12    X'FF'
         AND,12   J:RNST
         BEZ      LEX9
         LI,12    0
         LW,1     Y4
         STS,1    J:STAR+5          SET ACCESS CTL BIT
         LI,1     3
         AI,9     'N'
         STB,12   J:RNST,1
         LCI      9
         LM,0     OPNFPT
         LI,2     LEX9        ERR & ABN
         LI,3     LEX9        ERR & ABN
         LI,6     4                 MODE-UPDATE
         LCI      4                 GET REST OF FPT
         LM,10    ACCNIND
         LCI      2
         LM,11    J:ACCN            GET ACCT #
         CAL1,1   0                 OPN FPT IN REGS 0 THRU 9, NAME IN 9
*D*
*D*               THE RECORDS IN THE 'IDN' FILE ARE READ SEQUENTIALLY
*D*               AND EACH RECORD IS CHECKED TO DETERMINE IF IT IS
*D*               A HEADER RECORD.
*D*
LEX65    EQU      %
         BBLC     1
         LI,R0    SBUF1VPA+IDNDISP
         LI,1     8                 2 WORDS
         CAL1,1   READF             READ THE HEADER
         LW,R1    SBUF1VPA+IDNDISP  CHECK FOR HEADER
         SLS,1    -8
         LI,2     X'FFFF'
         AND,2    J:JIT
         AI,2     X'30000'
         CW,2     1
         BNE      LEX1              NO HIT
         LW,R1    SBUF1VPA+NRECDISP
         BNEZ     LEX65
*D*
*D*               WHEN A HEADER IS FOUND, THE JIT INFORMATION RECORD IS
*D*               READ INTO SPECIAL BUFFER 1.
*D*
         LI,0     SBUF1VPA
         LI,1     JINFOSZ+CCBSIZ
         BBLC     3
         CAL1,1   READF
         BAL,1    DECREP
*D*
*D* J:CCBUF IS THEN RESTORED IF NECESSARY.
*D*
         LW,3     J:RNST
         SLS,3    13
         LC       3                 RESTORE ONLY IF...
         BCS,2    LEX66             CCSTAT=0 &
         BCR,1    LEX66             CCSTAT2=1
         LI,3     X'10000'          SET CCSTAT TO PREVENT ANOTHER RESTORE
         STS,3    J:RNST
         LD,2     GETCCBUF
         MBS,2    0                 MOVE TO J:CCBUF
         LB,2     SBUF1VPA+SYMTABDISP    GET SAVED JB:CCARS
         STB,2    JB:CCARS          AND PUT IT BACK
LEX66    EQU      %
*D*
*D*               THE PAGES FOR THE USER'S DCBS ARE OBTAINED AND THE
*D*               DCB RECORD IS READ.
*D*
         LW,6     SBUF1VPA+DCBSDISP # PAGES OF DCBS
         LW,1     6                 F0R LEX7
         BEZ      LEX1              NONE
         LCI      2
         LM,7     SBUF1VPA+DCBLLDISP DCBLL-DCBUL
         STM,7    J:DCBLL           FOR MM
         BAL,11   T:GNVPI           GET THE PAGES
         LW,1     SBUF1VPA+DCBSDISP # PAGES OF DCBS
         LW,0     J:DCBLL
         SLD,0    9                 BUF
         SLS,1    2                 SIZE
         BBLC     3
         CAL1,1   READ
*D*
*D*               THE DCB CHECKER IS CALLED TO INSURE THAT THE DCBS
*D*               ARE VALID.  ALL OPEN DCBS ARE CLOSED.
*D*
         SLS,1    -11               # DCB PGS
         BAL,12   CKDCBS
         BCS,3    %+3               ERROR-DONT TRY TO CLOSE
         LI,6     0                 DONT CLOSE M:XX
         BAL,11   CLOSE+1
*D*
*D*               THE PAGES THAT WERE USED TO READ THE DCBS ARE THEN
*D*               RELEASED.
*D*
         LW,7     J:DCBLL           FIRST PAGE TO RELEASE
         LW,6     SBUF1VPA+DCBSDISP # OF PAGES TO RELEASE
         BAL,11   T:RVPI
         NOP
         AI,7     1
         BDR,6    %-3
*D*
*D*               THE REST OF THE RECORDS IN THE RCORD SET ARE READ UNTIL
*D*               THE TRAILER RECORD IS FOUND.  THEN WE BEGIN AGAIN
*D*               SEARCHING FOR THE NEXT HEADER RECORD.
*D*
LEX1     LI,0     SBUF1VPA
         LI,1     8
         BBLC     3
         CAL1,1   READF
         LW,0     SBUF1VPA
         SLS,0    -8
         LI,1     X'FFFF'
         AND,1    J:JIT
         AI,1     X'30000'
         CW,1     0
         BE       LEX65
         B        LEX1
*
LEX2     EQU      LEX1
*D*
*D*               WHEN THE END OF FILE IS REACHED, THE FILE IS CLOSED
*D*               WITH RELEASE SPECIFIED.
*D*
LEX3     LB,0     10                ABN CODE
         CI,0     7                 LOST DATA
         BGE      LEX1
         CI,0     4
         BLE      LEX1
         LI,6     M:XX
         LCI      3
         LM,0     CLOSEWD0
         LI,2     1                 RELEASE IT
         CAL1,1   0
*D*
*D*               THE FIRST BYTE OF J:RNST AND J:ERO ARE RESTORED.
*D*               SPECIAL BUFFER 1 IS RELEASED AND CONTROL RETURNS TO
*D*               THE RUNDOWN LOGIC IN THE STEP OVERLAY.
*D*
LEX9     EQU      %
         LI,12    0
         STH,12   J:CFLGS           CLEAR FLGS & APO
         LI,12    JBUPVP
         STW,12   J:DCBLL
         AI,12    -1
         STW,12   J:DCBUL
         PULL     0
         STB,0    J:RNST            RESTORE BYTE 0 OF RNST
         LW,R4    SBUF1VPA+ERODISP
         STW,4    JIT+ERO
         PULL     2,6
         LI,14    SBUF1VPA
         LI,5     0
         BAL,2    T:RBUF
         PULL     11
         B        T:SELFDESTRUCT    AFTER DISASSOCIATING LDLNK OVERLAY
*                                   RETURN TO EXIT LOGIC IN STEP
         PAGE
*
CHECKVAL EQU      %
         SLS,8    -9
         CLM,8    *7                WITNIN LIMITS
         BCS,9    ILLEGAL           NO
         B        *11
*E*
*E*      ERROR:   B5-68
*E*      MESSAGE: LOAD AND LINK OPERATION IS ILLEGAL AS SPECIFIED
*E*
ILLEGAL  EQU      %
         LI,10    X'68'
         B        NOCORE2+1
         PAGE
**************************************
*D* AT LDTSETUP, WE SET UP FOR ENTRY INTO THE M:LDTRC LOGIC
*D* AT LDT03:  WE TEST THE VALIDITY OF
*D* AN M:LDTRC AT THIS POINT, CONSTRUCT IDN
*D* FROM LINKCNT-1 & BUILD A DUMMY FPT
*D* FOR M:LDTRC. THE LINK COUNT IS THEN DECREMENTED.
**************************************
LDTSETUP EQU      %
         BAL,11   TRUNK             NO DCBS SHOULD BE OPEN-CHK ANYHOW
         BAL,5    VALID             CAN WE DO A LDTRC
         BAL,5    CREFPT            CREATE FPT
         B        LDT03             GO DO LDTRC
         PAGE
****************************************************************
*F*      NAME:    T:SAVESWAPIMG                                *
*F*      PURPOSE: TO SAVE THE SWAP IMAGE OF A USER WHOSE LINE  *
*F*               HAS BEEN DISCONNECTED UNTIL HE CAN DIAL BACK *
*F*               IN - WHICH HE MUST DO WITHIN A CERTAIN       *
*F*               (SL:RET) AMOUNT OF TIME OR BE LOGGED OFF.    *
*F*      DESCRIPTION:                                          *
*F*               T:SAVESWAPIMG IS ENTERED FROM STPNR AT THE   *
*F*               START OF RUNDOWN IF A USER'S LINE HAS BEEN   *
*F*               REPORTED OFF.  THE DISCONNECTED USER IS      *
*F*               PLACED IN THE WAIT STATE FOR THE NUMBER OF   *
*F*               MINUTES INDICATED IN SL:RET.  THE USER WILL  *
*F*               BE RECONNECTED TO A LINE AND RESTARTED IF HE *
*F*               IS AWOKEN BY A M:ASI CAL.  IF HE SIMPLY TIMES*
*F*               OUT, THEN HE WILL BE LOGGED OFF.             *
****************************************************************
*D*      NAME:    T:SAVESWAPIMG                                *
*D*      REGISTERS: ALL ARE VOLATILE                           *
*D*      CALL:    BAL,11  T:SAVESWAPIMG                        *
*D*      INTERFACE:                                            *
*D*               T:REG - USED TO PUT A HUNG-UP USER TO SLEEP  *
*D*               T:SSEM - RETURN POINT IF USER IS TO RESUME   *
*D*                        EXECUTION                           *
*D*               COCDSABL - DISABLE COC INTERRUPTS            *
*D*               COCENABL - ENABLE COC INTERRUPTS             *
*D*               COCGETB - ACQUIRE A COC BUFFER               *
*D*               COCPUTBL - RELEASE A COC BUFFER              *
*D*      ENVIRONMENT:  MASTER, MAPPED                          *
*D*      INPUT:   J:ACCN - USER'S ACCOUNT                      *
*D*               J:TELFLGS - FLAGS USED BY TEL                *
*D*               J:UNAME - USER'S NAME                        *
*D*               JH:LDCF - FEATURE AUTHORIZATION FLAGS        *
*D*               M:UC+COCLN - LINE NUMBER                     *
*D*               MODE2 - COC LINE INFO                        *
*D*               MODE4 - COC LINE INFO                        *
*D*               P:NAME - SHARED PROCESSOR NAME TABLE         *
*D*               SH:SYMT - FAUTH MNEMONICS                    *
*D*               SL:RET - RETENTION TIME FOR SAVED IMAGE      *
*D*               SV:FTYM - LENGTH OF SH:SYMT                  *
*D*               UH:DL - DO LIST                              *
*D*      OUTPUT:  J:RNST - 0 OR 8 (LINE DISCONNECT FOR LOGOFF) *
*D*               LB:UN - ZEROED FOR OLD LINE,                 *
*D*               M:UC+COCLN - NEW LINE # IF RECONNECTED       *
*D*                            X'FF' IF TIMED OUT.             *
*D*               UH:FLG - STEP IN PROGRESS RESET ON RECONNECT *
*D*      SCRATCH: U:MISC - TIME TO REMAIN IN SLEEPING STATE    *
*D*               UH:FLG2 - BIT 9 SET WHILE SUSPENDED          *
*D*               UH:WL - POINTS TO LINKED PAIR OF COC BUFFERS *
*D*                       WHILE USER IS SUSPENDED.             *
*D*      DESCRIPTION:                                          *
*D*               ON ENTRY, THE USER WILL BE LOGGED OFF IF ANY *
*D*               OF THE FOLLOWING CONDITIONS HOLD:            *
*D*               1) SL:RET=0   2) THE USER IS AT JOB STEP     *
*D*               3) THERE IS ALREADY AN IMAGE SAVED FOR HIM   *
*D*               4) NO COC BUFFERS AVAILABLE                  *
*D*               5) LOGON IS THE ASSOCIATED PROCESSOR         *
*D*               6) USER ISN'T AUTHORIZED FOR AUTOSAVE        *
*D*               OTHERWISE, THE RETENTION TIME IS COPIED FROM *
*D*               SL:RET TO U:MISC, THE LINE HANGUP FLAG IN    *
*D*               UH:FLG2 IS RESET AND THE DISCONNECTED USER   *
*D*               FLAG (BIT 9) IS SET.  LB:UN IS SET TO 0 FOR  *
*D*               THE USER'S OLD LINE.  THE USER'S ACCOUNT AND *
*D*               NAME ARE KEPT IN A PAIR OF COC BUFFERS       *
*D*               POINTED TO BY UH:WL, AND A SLEEP EVENT IS    *
*D*               REPORTED VIA T:REG.                          *
*D*               WHEN A USER IS LATER WOKEN UP BY T:ASI OR    *
*D*               CLOCK4, THE COC BUFFERS ARE RELEASED, AND    *
*D*               THE SUSPENDED USER FLAG IN UH:FLG2 IS RESET. *
*D*               IF U:MISC IS NON-ZERO, THE USER WAS AWOKEN BY*
*D*               T:ASI. IN THIS CASE, THE LINE NUMBER PASSED  *
*D*               BY T:ASI IN BITS 1-8 OF U:MISC IS COPIED INTO*
*D*               THE USER'S JIT, THE SAVED TIMING ALGORITM NO.*
*D*               IS RESTORED TO MODE4, AND CONTROL RETURNED TO*
*D*               THE USER VIA T:SSEM.
*D*               IF U:MISC IS ZERO, THE USER TIMED OUT.  TO   *
*D*               COMPLETE THE LOGOFF PROCESS, THE LINE HANGUP *
*D*               FLAG IN J:RNST IS SET SO THAT STEP WILL CALL *
*D*               LOGON (FROM T:ECA).  THE USER'S LINE NUMBER  *
*D*               IN M:UC IS SET TO X'FF' SO THAT ANY TERMINAL *
*D*               I/O WHICH MIGHT BE ATTEMPTED IN AN EXIT      *
*D*               CONTROL ROUTINE WILL BE IGNORED, AND CONTROL *
*D*               IS RETURNED TO STPNR AT T:TELDEL2.           *
****************************************************************
*
T:SAVESWAPIMG EQU %
         MTW,0    SL:RET
         BEZ      T:SELFDESTRUCT    ZERO RETENTION TIME
         LW,1     S:CUN             CURRENT USER #
         LW,2     J:TELFLGS         ARE WE AT JOB STEP?
         CI,2     1
         BANZ     T:SELFDESTRUCT    YES-DONT BOTHER WITH SAVE
         LB,2     UB:ACP,1          GET ACP #
         LD,4     TCLOGON
         CD,4     P:NAME,2          IS IT LOGON???
         BE       T:SELFDESTRUCT    YEP-DONT WANT TO SAVE IT
         LI,2     SV:FTYM           LENGTH OF SH:SYMT
         LI,4     X'FC1E2'          IS AUTOSAVE FAUTH-ED???
         CH,4     SH:SYMT,2         LOOK FOR 'AS'
         BE       %+3               YES
         BDR,2    %-2               LOOK THRU WHOLE TABLE
         B        NOFAUTH           NOT THERE
         LI,4     X'8000'
         LCW,2    2
         SLS,4    0,2               SHIFT A BIT, AND SEE IF THIS GUY'S
         CW,4     JH:LDCF           AUTHORIZED FOR AUTO-SAVE
         BAZ      T:SELFDESTRUCT    NOPE, HE'S NOT.
NOFAUTH  EQU      %
         BAL,5    COCGLN            GET COC LINE # IN R2
         B        T:SELFDESTRUCT    B/NOT ONLINE, OR LINE .FF
         LB,6     COCTERM,2         L/TERMINAL TYPE
         LH,10    COCOTV,6          L/OUTPUT TRANS TBL ADR
         LI,7     1                 L/1; INDEX TO FIRST MESS BYTE
         BAL,13   COCDSABL          DISABLE COC INTERRUPTS
SNDPH5   LB,5     TCPH,7            L/BYTE OF 'PROGRAM HELD'
         BAL,9    COCSENDX          SEND CHARACTER
         AI,7     1                 INC BTD
         CB,7     TCPH              C/BTD W/BC OF MESS
         BLE      SNDPH5            BLE; SEND NEXT CHAR
         BAL,13   COCENABL          ENABLE COC INTERRUPTS
         PUSH     11
         BAL,15   CHKWAITQ          SWAP IMAGE FOR THIS ACCT?
         CI,5     0                 R5=0 MEANS NO SWAP IMAGE
         BE       %+3               DONT SAVE >1 PER ACCT,NAME
         PULL     11
         DESTRUCT
         BAL,15   SAVEACCT          SAVE ACCT,NAME IN COC BUFRS
         BCS,8    %-3               COULDNT GET COC BUFFERS
         BAL,5    COCGLN            GET COC LINE # IN R2
         DATA     0                 NOT ONLINE, OR LINE .FF
         LI,4     5                 L/5; INDEX TO LAST MODENO ENTRY
         LI,13    6                 L/6; #NOF ENTRIES TO MOVE
SAVTA4   LH,10    MODENO,4          L/ADR OF MODE TBL ENTRY
         LB,12    *10,2             L/MODE TBL ENTRY
         STB,12   8                 S/MODE TBL ENTRY IN SAVE REG
         SLD,8    -8                SHIFT SAVE REG RIGHT 1 BYTE
         AI,4     -1                DEC MODENO POINTER
         BDR,13   SAVTA4            BDR/GET NEXT MODE TBL ENTRY
         LB,12    COCTERM,2         L/TERM TYPE
         STB,12   8                 S/TERM TYPE IN SAVE REG
***
**** WARNING - R8 AND R9 MUST BE PRESERVED THRU TO RESTA4
***
         LW,1     S:CUN             L/CURRENT USER #
         LW,3     SL:RET            GET RETENTION TIME
         MI,3     50                CONVERT TO 1.2 SEC. UNITS
         STW,3    U:MISC,1          SET UP FOR WAIT
         LI,2     0
         LI,3     X'FF'
         AND,3    M:UC+COCLN        GET LINE NUMBER
         LI,4     BA(JB:ALN)        L/BA OF ACTUAL LINE #
         STB,3    0,4               S/ACTUAL LINE #
         DISABLE
         STB,2    LB:UN,3           AND RELEASE THIS GUYS LINE
         LB,4     MODE2,3
         AND,4    XFC               RESET ACTIVATION CHAR SET
         MTH,0    COCOC,3           ANYTHING TO BE OUTPUT
         BNEZ     %+2               YES
         AND,4    X7F               NO-SO RESET LINE OFF BIT
         STB,4    MODE2,3
         STB,2    J:RNST            ZAP LINE HANGUP FLAG IN JIT
         LH,2     UH:FLG2,1         RESET HANGUP FLAG IN ...
         AND,2    NB31TO0+6         USER TABLES AND SET
         OR,2     X40               DISCONNECTED USER FLAG
         STH,2    UH:FLG2,1
         LH,2     UH:DL,1
         AND,2    NB31TO0+16        RESET ABORT BIT IN DO LIST
         STH,2    UH:DL,1           SO USER WONT GET LOGGED OFF LATER
         ENABLE
         LI,6     E:SL              SLEEP EVENT
         BAL,11   T:REG             ...OFF TO BED
*  CLEANUP AFTER USER WAKES UP FOR RECONNECTION
         LH,4     UH:WL,1           GET PTR TO 1ST BUFFER
         INT,3    COCBUF,4          GET PTR TO 2ND
         SLS,3    2                 CONVERT BACK TO BYTE DISP
         SLS,4    2
         LI,2     -BUFCNT-BUFCNT-BUFCNT-BUFCNT
*                 THIS GETS COCPUTBL TO DECREMENT R0
         BAL,13   COCDSABL
         BAL,6    COCPUTBL          FREE 1ST BUFFER
         LW,4     3
         BAL,6    COCPUTBL          FREE 2ND BUFFER
         BAL,13   COCENABL
         LW,1     S:CUN             DISCONNECTED USER
         LI,2     0
         STH,2    UH:WL,1           ZAP TEMP BUFFER LINK
*                                   ***** UH:WL IN B00 *****
         DISABLE
         LH,2     UH:FLG2,1
         AND,2    NB31TO0+7         ZAP DISCONNECT FLAG
         STH,2    UH:FLG2,1
         ENABLE
         PULL     11                GET BACK RETURN ADDR.
         LI,3     3
         MTW,0    U:MISC,1
         BEZ      EXPIRE            USER  TIMED OUT
         LH,4     UH:DL,1           GET USER DO LIST
         CI,4     X'C000'           WAS IT 'X' OR 'E' KEYIN
         BANZ     EXPIRE            YEP - SCRATCH THIS GUY
         LI,2     LNOL-1            FIND THIS GUY'S NOW LINE...
         CB,1     LB:UN,2           ...IT WAS SET UP BY T:ASI
         BE       GOTLINE#          FOUND IT
         BDR,2    %-2
         CB,1     LB:UN             CHECK LINE ZERO TOO
         BNE      EXPIRE            NOT THERE, SUMTHIN WENT WRONG...
GOTLINE# EQU      %
         STB,2    M:UC+COCLN,3      TUCK LINE # AWAY IN JIT
         LH,2     UH:FLG,1
         AND,2    NB31TO0+15        RESET STEP IN PROGRESS
         STH,2    UH:FLG,1
         BAL,5    COCGLN            GET COC LINE # IN R2
         DATA     0                 NOT ONLINE, OR LINE # .FF
         LI,3     2                 L/2; INDEX TO MODE2 IN R8
         LB,14    8,3               L/SAVED MODE2
         LI,15    X'10'             L/.10; MASK FOR 2741 FLAG IN MODE2
         LB,13    MODE2,2           L/CURRENT MODE2
         CS,14    13                C/SAVED 2741 FLAG W/CURRENT
         BNE      RESTA9            BNE; 2741 -> ASCII, VICE VERSA
         LI,7     2741MASK          L/ADR OF 2741 MODE MASKS
         LC       MODE2,2
         BCS,1    RESTA2            B/2741 CURRENTLY
         LI,7     ASCIIMASK         L/ADR OF ASCII MASKS
         LB,14    8                 L/SAVED COCTERM
         STB,14   COCTERM,2         S/SAVED COC TERM TYPE AS CURRENT
RESTA2   LI,4     0                 L/0; INIT MODENO INDEX
         LI,13    6                 L/# OF BYTES TO MOVE
RESTA4   LH,10    MODENO,4          L/ADR OF A MODE TABLE
         SLD,8    8                 SHIFT SAVED MODE TBL ENTRIES
         LB,12    8                 L/SAVED MODE ENTRY
         LB,13    *7,4              L/MASK FOR CHANGEABLE BITS
         DISABLE                    INHIBIT INTERRUPTS
         LB,14    *10,2             L/CURRENT MODE TBL ENTRY
         STS,12   14                MODIFY CHANGEABLE BITS
         STB,14   *10,2             S/NEW CURRENT MODE TBL ENTRY
         ENABLE                     RESET INHIBITS
         AI,4     1                 INC MODENO POINTER
         BDR,13   RESTA4            BDR/MOVE NEXT MODE TBL ENTRY
RESTA9   ;
         DESTRUCT T:SSEM            GO BACK TO HIM
EXPIRE   EQU      %
         LI,2     X'FF'             SET LINE # OF AWOKEN USER
         STB,2    M:UC+COCLN,3      TO FF (NO I/O WILL BE DONE)
*                                   IMPLICIT LDTRC ON ABORT
         LI,4     8                 RESET LINE HANGUP FLAG TO
         STB,4    J:RNST            FORCE SCHEDULER TO GO TO LOGOFF
         DESTRUCT                   BACK TO WHERE WE LEFT STEP
ASCIIMASK DATA    X'8C6FE09F'       MASKS FOR RESTORING ASCII MODE BITS
         DATA     X'20020000'
2741MASK DATA     X'0C2FA01F'       MASKS FOR RESTORING 2741 MODE BITS
         DATA     X'20020000'
         PAGE
***************************************************************
*F*      NAME:    T:FSI                                       *
*F*      PURPOSE: FIND SUSPENDED IMAGE FOR CURRENT USER       *
*F*      DESCRIPTION:  CALLED FROM LOGON TO DETERMINE WHETHER *
*F*               TO SEND THE 'RECONNECT?' INQUIRY.           *
*F*                                                           *
*F*      NAME:    T:ASI                                       *
*F*      PURPOSE: ASSOCIATE SUSPENDED IMAGE FOR CURRENT USER  *
*F*      DESCRIPTION:  CALLED FROM LOGON IF RESPONSE TO       *
*F*               'RECONNECT?' MESSAGE WAS 'YES'.             *
*F*      REFERENCE:  SEE T:SAVESWAPIMG                        *
***************************************************************
*D*      NAME:    T:ASI                                       *
*D*      ENTRY:   T:FSI                                       *
*D*      REGISTERS:  ALL ARE VOLATILE                         *
*D*      CALL:    B  T:ASI                                    *
*D*               B  T:FSI                                    *
*D*      ENVIRONMENT:  MASTER, MAPPED                         *
*D*      INPUT:   S:CUN - CURRENT USER NUMBER                 *
*D*               J:ACCN - USER'S ACCOUNT                     *
*D*               J:UNAME - USER NAME                         *
*D*               U:MISC - REMAINING SLEEPY TIME              *
*D*               UH:FLG2 - SUSPENDED FOR RECONNECT BIT       *
*D*               UH:WL - POINTER TO LINKED COC BUFFER PAIR   *
*D*               UB:ACP - ASSOCIATED COMMAND PROCESSOR #     *
*D*               P:NAME - PROCESSOR NAME TABLE               *
*D*               M:UC+COCLN - USER'S LINE NUMBER             *
*D*               MODE4 - LINE TIMING ALGORITHM #             *
*D*      OUTPUT:  LB:UN - RECONNECTED USER'S NEW LINE NO.     *
*D*               CC1 IN USER PSD - RESET IF CAL SUCCESSFUL   *
*D*                                 SET IF CAL NOT SUCCESSFUL *
*D*      SCRATCH: U:MISC - LINE NO. SET INTO BITS 1-8         *
*D*      INTERFACE:                                           *
*D*               T:RUE - REPORT WAKEUP FOR SUSPENDED USER    *
*D*               TRAPEXIT - RETURN FROM CAL PROCESSING       *
*D*      DESCRIPTION:                                         *
*D*               THIS IS THE CAL HANDLER FOR THE FIND AND    *
*D*               ASSOCIATE SUSPENDED IMAGE CALS.             *
*D*               T:FSI CALLS CHKWAITQ TO FIND A SUSPENDED    *
*D*               PROGRAM UNDER THE CURRENT NAME,ACCT..  IF   *
*D*               ONE EXISTS, CC1 IN THE USER'S PSD IS RESET. *
*D*               OTHERWISE CC1 IS SET.                       *
*D*               T:ASI IN ADDITION WILL REASSOCIATE THE      *
*D*               SUSPENDED PROGRAM WITH THE CURRENT COC LINE *
*D*               AND ISSUE A WAKEUP EVENT FOR THE USER.  THE *
*D*               FINAL CLEANING UP WILL BE DONE IN THE       *
*D*               T:SAVESWAPIMG ROUTINE WHEN THE USER WAKES UP*
***************************************************************
*
*
T:FSI    EQU      %                 FIND SUSPENDED IMAGE
         LW,1     S:CUN             CURRENT USER #
         BAL,15   CHKWAITQ          IS CURR. USER ON WAIT QUEUE
         CI,5     0
         BE       SETCC1            NOPE
         WD,7     X'1500'           DISABLE CLOCK3 (R7 SETUP BY CHKWAITQ)
         MTW,0    U:MISC,1          IF IT DIDN'T TICK TO ZERO,
         BEZ      %+2               ...
         LI,5     16                THEN ADD 20 SECONDS TO WAIT TIME
         AWM,5    U:MISC,1          FOR SLOW TYPERS IN LOGON
         WD,7     X'1400'           TURN CLOCK3 BACK ON
         B        RSETCC1           RETURN WITH CC1=0
         SPACE    4
T:ASI    EQU      %
         LW,1     S:CUN             CURRENT USER #
         LB,5     UB:ACP,1          PICK UP ACP #
         LD,6     TCLOGON           TEXTC LOGON
         CD,6     P:NAME,5          IS IT LOGON RUNNING?
         BNE      SETCC1            NO-DONT ALLOW ASSOCIATION
         LI,2     X'80'
         BAL,15   CHKWAITQ          FIND USER'S SAVED IMAGE
*                                   OLD MODE4 RETURNED IN R8
         WD,2     X'1500'           DISABLE CLOCK3
         CI,5     0                 DID WE FIND ONE
         BNE      %+3               YEP
         WD,2     X'1400'           ENABLE CLOCK3
         B        SETCC1            AND RETURN WITH CC1 SET
         LI,6     X'FF'
         AND,6    M:UC+COCLN        EXTRACT LINE # FROM JIT
         LB,7     MODE4,6           GET NEW MODE4 BYTE
         LI,9     X'38'             MASK TO SELECT TIMING ALGORITHM
         STS,8    7                 STICK IN SAVED TIMING ALG.
         STB,7    MODE4,6           AND REPLACE MODE4
         WD,2     X'1400'           CLOCK3 BACK ON AGAIN...
         LI,1     3                 L/BTD TO LINE # IN M:UC
         LI,9     X'FF'             L/.FF; FUNNY LINE #
         STB,9    M:UC+1,1          L/FUNNY LINE #; IGNORE TERM REQUESTS
         STB,5    LB:UN,6           GIVE LINE TO SAVED USER
         LW,1     TSTACK
         STW,5    -7,1              RETURN USER # IN SR1
         STW,6    -13,1             RETURN NEW LINE # IN R2
         LI,6     E:WU              WAKEUP EVENT
         BAL,11   T:RUE             REPORT IT
RSETCC1  LI,4     0
         B        %+2
SETCC1   LW,4     Y8
         LW,5     YF                MASK FOR CC
         LW,1     TSTACK
         STS,4    -18,1             SET CC IN PSD
         DESTRUCT TRAPEXIT          ALL DONE
         PAGE
*****************************************************
*  CHKWAITQ EXAMINES EACH USER,                     *
*  LOOKING FOR A USER UNDER THE CURRENT ACCNT &     *
*  USER NAME WHOSE LINE HUNG UP ON HIM.             *
*  BIT 9 OF UH:FLG2 INDICATES A DISCONNECTED USER.  *
*  ON ENTRY: R1 = CURRENT USER NUMBER.              *
*  ON EXIT:  R5 = USER # ON QUEUE, IF PRESENT       *
*               = 0 IF NOT (NO SAVED IMAGE)         *
*****************************************************
CHKWAITQ EQU      %
         LI,5     SMUIS             GET MAX # USERS IN SYST.
         LI,7     X'80'
         LH,3     UH:FLG2,5         GET USER FLAGS
         CI,3     X'40'             CHECK DISCONNECT BIT
         BANZ     CHKWU             B IF ITS ON
CHKNXT   BDR,5    %-3
         B        *15
CHKWU    WD,7     X'1500'           DISABLE CLOCK3
         MTW,0    U:MISC,5          DID HE TIC TO ZERO?
         BGZ      %+3               NOPE
         WD,7     X'1400'           YES-SO ENABLE CLOCK3 & GO
         B        CHKNXT            LOOK FOR ANOTHER USER
         BAL,14   CBUFCHECK         IS HE UNDER CURRENT ACCT,NAME
         BCR,8    CK3ENABL          YES
         WD,7     X'1400'           NO-SO ENABLE CLOCK3...
         B        CHKNXT            AND CHECK THE NEXT GUY
CK3ENABL WD,7     X'1400'           ENABLE CLOCK3
         B        *15               AND EXIT
         SPACE    4
CBUFCHECK EQU     %
         LH,3     UH:WL,5           THIS WILL POINT TO COC BUFR
         LW,4     3                 COPY POINTER
         SLS,4    -1                MAKE IT DOUBLEWORD INDEX
         LCI      2
         LM,8     J:ACCN            GET CURRENT ACCOUNT
         CD,8     COCBUF+2,4        COMPARE W/ACCT IN COCBUF
         BNE      INVALID%ID
         INT,3    COCBUF,3          GET LINK TO NEXT BUFFER
         LCI      3
         LM,9     J:UNAME           GET CURRENT USER NAME
         CW,9     COCBUF+1,3        COMPARE 1ST WD W/NAME IN COCBUF
         BNE      INVALID%ID
         SLS,3    -1
         CD,10    COCBUF+2,3        COMPARE NEXT 2 WDS
         BNE      INVALID%ID
         SLS,4    1                 BACK TO WORD INDEX
         LW,8     COCBUF+1,4        RETURN SAVED MODE4 IN R8
         LCI      0                 CC1=0 MEANS ID'S MATCH
         B        *14
INVALID%ID EQU    %
         LCI      8                 CC1=1 MEANS THEY DONT
         B        *14
         SPACE    4
SAVEACCT EQU      %
         PUSH     15                SAVE RTN ADDR
         LI,2     -BUFCNT-BUFCNT-BUFCNT-BUFCNT  = -BA(BUFCNT)
         BAL,13   COCDSABL          DISABLE COC INTERRUPTS
         BAL,6    COCGETB           GET BUFR TO HOLD ACCOUNT
         B        CANTSAVE          NONE AVAILABLE
         LW,3     4                 SAVE POINTER
         BAL,6    COCGETB           GET BUFFER TO HOLD NAME
         B        CANTSAVE1         NONE AVAILABLE
         BAL,13   COCENABL
         SLS,3    -2                CONVERT TO WORD DISP TO BUFR
         SLS,4    -2                DITTO
         STH,3    UH:WL,1           SAVE POINTER FOR RECONNECT
         STW,4    COCBUF,3          CHAIN OUR BUFFERS
         LCI      5
         LM,8     J:ACCN            GET ACCOUNT,NAME
         LCI      2
         STM,8    COCBUF+2,3        SAVE ACCNT IN 1ST COC BUFR
         LCI      3
         STM,10   COCBUF+1,4        SAVE NAME IN 2ND ONE
         LI,2     X'FF'
         AND,2    M:UC+COCLN        LINE #
         LB,8     MODE4,2
         STW,8    COCBUF+1,3        SAVE TERMINAL TYPE
         PULL     15
         LCI      0                 CC1=0 MEANS EVERYTHING OK
         B        *15
CANTSAVE1 EQU     %
         LW,4     3
         BAL,6    COCPUTBL          FREE OUR FIRST BUFFER
CANTSAVE EQU      %
         BAL,13   COCENABL
         PULL     15
         LCI      8                 CC1=1 MEANS NO AVAIL COC BUFRS
         B        *15
         PAGE
*F*
*F*      NAME:    VALID
*F*
*F*      PURPOSE: TO DETERMINE IF IT IS LEGAL TO EXECUTE THE
*F*               M:LINK/M:LDTRC CAL.
*F*
*F*      DESCRIPTION:  SEE 'D' REPORT
*F*
*D*      NAME:    VALID
*D*
*D*      CALL:    BAL,5  VALID
*D*
*D*      DESCRIPTION:
*D*               IF A SPECIAL SHARED PROCESSOR OTHER THAN A CORE LIBRARY
*D*               IS ASSOCIATED WITH THE USER HE IS ABORTED WITH
*D*               ERROR CODE B5-62.
*D*
VALID    LW,1     S:CUN
         LB,2     UB:ASP,1
         BEZ      VALID3            NO ASP - OK
         LW,4     P:SA,2
         LC       4
         BCS,1    VALID3            ASP IS CORE LIB - OK
         LI,10    2
         B        INVALID
*E*
*E*      ERROR:   B5-62
*E*      MESSAGE: LOAD AND LINK NOT PERMITTED WHEN A SPECIAL PROCESSOR
*E*               OTHER THAN A CORE LIBRARY IS ASSOCIATED
*E*
*D*
*D*               IF THE PROGRAM WAS BUILT BY LINK THE USER IS ABORTED
*D*               WITH ERROR CODE B5-63.
*D*
VALID3   EQU      %
         LB,4     JB:PCP
         BNEZ     VALID35           IF NO PP THEN MUST BE LINK-ERROR
         CI,2     0
         BNE      VALID35
         LB,2     UB:APR,1
         BEZ      VALID4
VALID35  EQU      %
         LW,4     J:DDLL
         AI,4     -1
         CW,4     J:PUL
         BGE      %+3               DD > PROCEDURE  OK
VALID4   EQU      %
         LI,10    3
         B        INVALID
*E*
*E*      ERROR:   B5-63
*E*      MESSAGE: LOAD AND LINK IS PERMITTED ONLY WITH PROGRAMS
*E*               CREATED BY OVERLAY LOADER
*E*
*D*
*D*               THE USER MUST NOT HAVE OBTAINED OR RELEASED ANY
*D*               DYNAMIC DATA VIA THE M:GVP/M:FVP CALS OR HE IS
*D*               ABORTED WITH ERROR CODE B5-64.  THIS IS DETERMINED BY
*D*               # OF COMMON PAGES + # OF DYNAMIC PAGES NOT EQUAL
*D*               TO THE DYNAMIC DATA PAGE COUNT.
*D*
*D*
*D*               THE USER MUST HAVE RUN DOWN ANY REAL-TIME ICBS
*D*               BEFORE ISSUING M:LINK OR M:LDTRC.
*D*
         LC       J:ICBHDR          ANY R/T CALS ISSUED?
         BCR,8    VALID4A           IF NOT SKIP THIS CODE
         LI,1     X'1C'             BYTE DSPL OF USER# IN ICB
         LI,2     ICB               WA(FIRST SYSGEN ICB)
         LI,4     NINTS             # OF SYSGEN-BUILT ICBS
         BEZ      VALID4A           B/IF NO ICBS
         LW,9     S:CUN             MY USER #
         DISABLE                    ** DISABLE **
VALID36  LW,3     0,2               L/FIRST WORD OF ICB
         BGEZ     VALID37           B/IF NOT ACTIVE
         CB,9     *2,1              C/USER # WITH MINE
         BNE      VALID37           B/IF NOT MY ICB
         ENABLE                     ** ENABLE **
         LI,10    X'10'             FOR B570 ERROR
         B        INVALID           REPORT ERROR
*E*
*E*      ERROR:   B5-70
*E*      MESSAGE: LOAD AND LINK IS ILLEGAL WITH REAL-TIME ICBS PRESENT
*E*
VALID37  AI,2     ICBSIZE           BUMP TO NEXT ICB
         BDR,4    VALID36           TEST NEXT ICB
         ENABLE                     ** ENABLE **
VALID4A  EQU      %
         LW,4     Y004
         CW,4     J:ASSIGN          ARE THERE TP CALS OUTSTANDING
         BAZ      VALID40           NOPE
         LI,10    X'E'              REPORT B56E ERROR MESSAGE
         B        INVALID
*E*      ERROR:   B5-6E
*E*      MESSAGE: M:LINK/LDTRC ILLEGAL FOR PROGRAMS WITH TP CALS
*E*               OUTSTANDING.
VALID40  EQU      %
         CI,5     LNK01             IF THIS IS NOT AN M:LINK CAL
         BNE      *5                  THEN WE NEEDN'T DO THIS STUFF.
         LI,3     JBBCP
         LB,3     J:JIT,3
         LW,4     J:DDUL
         SW,4     3                 # OF COMMON
         LB,3     JB:TDP
         BNEZ     %+2               IF = 0 ITS AN EXTENDED USER WITH
         LI,3     X'100'             DD TO THE TOP OF VIRTUAL CORE
         SW,3     J:DDLL            # OF DYN
         AW,4     3
         LI,3     JBPCDD
         LB,3     J:JIT,3
         CW,3     4
         BE       VALID45           OK
         LW,9     J:DDLL            POSSIBLE SYMBOL TAB PGS
         SW,9     J:PUL
         AI,9     -1                # OF PGS RESERVED
         BEZ      VALID44           NONE
         LW,7     J:PUL
         AI,7     1                 1ST SYM TAB PAGE
VALID41  LOAD,8   JX:CMAP,7
         CI,8     FPMC              IS IT ALLOCATED
         BE       VALID42           NO
         AI,3     -1                YES-DECREMENT # OF DD PGS
         AI,7     1                 TO LOOK AT NEXT PAGE
VALID42  BDR,9    VALID41
         CW,3     4                 NOW IS DD PGS OK
         BE       VALID45           YES
VALID44  LI,10    4
         B        INVALID
*E*
*E*      ERROR:   B5-64
*E*      MESSAGE: LOAD AND LINK IS NOT PERMITTED ON PROGRAMS NOT OWNING
*E*               ALL VIRTUAL MEMORY FROM DATA THROUGH DYNAMIC DATA
*E*
*D*
*D*               THE MEMSET ROUTINE IS CALLED TO INSURE FULL MEMORY
*D*               ALLOCATION IN THE DATA, PROCEDURE, AND DCB AREAS.
*D*
VALID45  PSW,5    TSTACK            SAVE RETURN
         LW,7     J:DLL             INSURE FULL MEMORY ALLOCATION
         LW,2     J:DUL             FOR DATA AND PP             #6123
         BAL,11   MEMSET                                        #6123
         LW,7     J:PLL
         LW,2     J:PUL                                         #6123
         BAL,11   MEMSET                                        #6123
         LW,7     J:DCBLL
         LW,2     J:DCBUL
         BAL,11   MEMSET
         PLW,5    TSTACK                                        #6123
         B        *5
*
*
*
INVALID  EQU      %
*        IF A B566 ERROR OCCURS, UB:APR MUST BE ZEROED TO
*        PREVENT THE PROCESSOR'S USE COUNT FROM GOING
*        NEGATIVE.
         CI,10    6                 B5-66 ERROR?
         BNE      %+4               IF NOT DON'T CHANGE UB:APR
         LI,5     0
         LW,3     S:CUN
         STB,5    UB:APR,3
         AI,10    X'60'
         SCS,10   -8
         B        ABORT
*
*
*
NOCORE   STB,7    UB:ASP,4          BECAUSE WE CANT ASSOCIATE IT
         STB,7    UB:DB,4
         LI,10    X'6D'
         B        NOCORE2+1
*E*
*E*      ERROR:   B5-6D
*E*      MESSAGE: PHYSICAL CORE FOR LIBRARY NOT AVAILABLE FOLLOWING
*E*               LNKTRC
*E*
*E*
NOCORE2  LI,10    7
         BAL,1    DECREP
         B        INVALID+1
*E*
*E*
*E*      ERROR:   B5-07
*E*      MESSAGE: PROGRAM OVERLAPS CURRENTLY ALLOCATED PAGES
*E*
*E*
DECREP   LW,7     SBUF1VPA+PRFLDISP
         LB,6     7                 GET APR IF ANY
         MTB,-1   PB:REP,6
         LI,6     X'FF'
         AND,6    7
         MTB,-1   PB:REP,6
         LI,6     X'FF00'
         AND,6    7                 GET DB (IF ANY)
         SLS,6    -8
         MTB,-1   PB:REP,6
         B        *1
         PAGE
***********************************************
*        MOVE FPT FROM USER AREA TO TSTACK
***********************************************
MOVEFPT  EQU      %
         PUSH     5
         LI,R7    JSBUF1VP
         LOAD,R7  JX:CMAP,R7        LOOK TO SEE IF WE ALREADY HAVE
         CI,R7    FPMC               A PAGE IN THE WINDOW
         BNE      %+3               YES, DON'T GET ANOTHER ONE
         LI,14    SBUF1VPA
         BAL,2    T:GBUF
         PULL     5
MVFPT1   PULL     2,6               PULL FPT(0) AND PTR TO FPT(1)
         PULL     4                 GET EXIT ADDRESS
         LW,3     Y2                FLG INDIC BUFFER USE
         STS,3    J:CFLGS
         LI,R3    SBUF1VPA+NRECDISP
         LI,2     +19
         LW,8     TSTACK+1,2
         STW,8    *3,2
         BDR,2    %-2
         LI,2     -19
         MSP,2    TSTACK
         AI,3     20
         LCI      8
         LM,8     *7                GET FPT
         STM,8    *3
         PUSH     4                 EXIT ADR
         PUSH     6                 WD0 OF FPT
         PUSH     3                 NEW POINTER TO FPT+1
         B        *5
         PAGE
**************************************
*D* CREATE LDTRC FPT IN BUFFER
*D* EXPECT LINK COUNT IN R7
**************************************
CREFPT   EQU      %
         PUSH     5                 SAVE RETURN
         LI,14    SBUF1VPA
         BAL,2    T:GBUF            GET SPECIAL BUFFER PAGE
         PULL     5
         LI,R3    SBUF1VPA+FPTDISP  DISPLACEMENT OF FPT IN BUFFER
         LW,9     Y2
         STS,9    J:CFLGS           SET FLAG TO INDICATE BUFFER USE
         LI,7     X'FF'
         AND,7    J:RNST            GET (LAST) LINK COUNT
         MTW,-1   7                 GOING FOR NEXT LOWER FILE.
         INT,9    J:JIT             GET SYS ID
         SLS,9    8                 MAKE LAST IDN FILE NAME
         OR,9     7
         OR,9     Y03
         STW,9    *3                STORE AS WORD 1 OF FPT
         LI,1     TRAPEXIT          EXIT ADDR.
         LW,2     Y03               WORD 0 OF LDTRC FPT
         PUSH     3,1               PUSH EXIT ADR,WD0 OF FPT,
*                                   AND POINTER TO FPT+1
         B        MVFPT1            BUILD STACK AS IF CAL ENTRY
         PAGE
*
*   RELEASE BUFFER AND MOVE ENVIRONMENT BACK TO TSTACK
*   NOTE:  TSTACK MUST BE EMPTY WHEN RELBUF IS CALLED
*
RELBUF   EQU      %
         LW,3     Y2
         LI,2     0
         STS,2    J:CFLGS           INDICATE BUFFER HAS BEEN RELEASED
*   MOVE ENVIRONMENT FROM BUFFER BACK TO TSTACK
         LI,2     19
         MSP,2    TSTACK
         LI,R15   SBUF1VPA+NRECDISP
         LW,9     *15,2
         STW,9    TSTACK+1,2
         BDR,2    %-2
*   RELEASE THE BUFFER
         PUSH     7,11
         LI,14    SBUF1VPA          BUFFER TO RELEASE
         PSW,5    TSTACK
         LI,5     0                 TO RELEASE VP/PP/SWAP GRAN
         BAL,2    T:RBUF            RELEASE BUFFER
         PLW,5    TSTACK
         PULL     7,11
         B        *5
         PAGE
*************************************
*  TRUNK- TRUNCATES ALL OPEN FILES  *
*  CLOSE- CLOSES    ALL OPEN FILES  *
*************************************
*
CLOSE    LI,6     M:XX              TO CLOSE M:XX TOO
         PUSH     11                SAVE RETURN
         OVERLAY  CLSSEG,CLSALL#
         PULL     11                RETURN ADDR
         B        *11               EXIT
TRUNK    EQU      %
         LW,8     Y002              FOR OPEN TEST
         LI,4     J:DCBLINK
TRUNK1   EQU      %
         LW,4     0,4
         BEZ      *11               FINISHED
TRUNK2   EQU      %
         AI,4     1
         LB,3     *4                CNT OF NAME
         BEZ      TRUNK1            PNTS TO CONTUATION OF DCB TAB
         SLS,3    -2
         AI,3     1
         AW,4     3
         LW,6     0,4               GET DCB ADDRESS
         CW,8     0,6
         BAZ      TRUNK2            NOT OPEN
         LCI      2
         LM,0     TRUNKFPT
         CAL1,1   0
         LCI      4
         LM,0     CHECKFPT
         CAL1,1   0
         LI,2     -1
         B        TRUNK2
         PAGE
*
*        GET PROCS & FLGS
*        6 = APR,APO,DB,ASP  7= FLGS
*
PROCFLG  EQU      %
         LW,1     S:CUN
         LB,7     UB:ASP,1          GET ASP #
         STB,7    6
         SLS,6    -8
         LB,7     UB:DB,1           GET DB #
         STB,7    6
         SLS,6    -8
         LB,7     UB:APO,1          GET AP OVERLAY #
         STB,7    6
         SLS,6    -8
         LB,7     UB:APR,1          GET AP ROOT #
         STB,7    6
         LH,7     UH:FLG,1          GET USERS FLAGS
         B        *5
         PAGE
*
*        RELEASE PROCESSORS
*
RELCORE  EQU      %
         LI,6     X'FFFF'           DID JOBENT LEAVE SOME DISK GRANS..
         AND,6    J:JIP             ..HANGING AROUND IN A DCB...
         BEZ      NOJE              --->NO.  ALL OK.
         PUSH     10                YEP..GOTTA GIVE BACK..R6=DA(DCB).
         OVERLAY  MISOVSEG,T:JECLS#
         PULL     10
NOJE     EQU      %
         LW,4     S:CUN
         LI,5     0
         LD,2     DOUBLEZERO        SET FOR NO DEBUGGER
         STD,R2   SBUF1VPA+DBUGDISP
         LB,6     UB:DB,4           IS DELTA ASSOCIATED
         BEZ      RELC3             NO
         LH,15    UH:FLG,4
         AND,15   XFBFF             RESET DELTA ASSOCIATED
         STH,15   UH:FLG,4
         LD,2     P:NAME,6          GET TEXTC DELTA
         MTB,0    UB:ASP,4          IS A CORE LIBRARY ALSO ASSOCIATED
         BNEZ     %+2               YES-DELTAS UC IS ALREADY DECREMENTED
         MTB,-1   PB:UC,6           NO-DECREMENT IT NOW
         STB,5    UB:DB,4           RESET DEBUGGER
         CI,10    LNK7RLCO+1        CHECK BAL ADDRESS
         BE       %+2               M:LINK-DONT DECREMENT REP
         MTB,-1   PB:REP,6
         STD,R2   SBUF1VPA+DBUGDISP SAVE FOR EXIT ENVIRONMENT
         LI,7     JSPVP             VP# OF DELTA'S DATA
         BAL,11   T:RVPI            RELEASE IT
         NOP
RELC3    EQU      %
         LB,6     UB:ASP,4
         BEZ      RELC4
         MTB,-1   PB:UC,6           DECR USAGE CNT
         STB,5    UB:ASP,4                        & REL ASP
         CI,10    LNK7RLCO+1        CHECK BAL ADR
         BE       %+2               B/M:LINK; DON'T DECREMENT PB:REP
         MTB,-1   PB:REP,6          DECREMENT NUMBER OF USERS ASSOCIATED
RELC4    EQU      %
         LB,6     UB:APR,4
         BEZ      RELC6
         MTB,-1   PB:UC,6           DECR
         STB,5    UB:APR,4               & REL APR
         CI,10    LNK7RLCO+1        CHECK BAL ADR
         BE       %+2               B/M:LINK; DON'T DECREMENT PB:REP
         MTB,-1   PB:REP,6          DECREMENT NUMBER OF USER ASSOCIATED
         LI,3     FPMC
         LB,7     PB:PVA,6          GET VIRT START OF PURE P
         LB,2     PB:PSZ,6          GET # OF PG OF PURE P
         STORE,3  JX:CMAP,7         CLEAR PROC OUT OF USER MAP
         AI,7     1
         BDR,2    %-2
         LB,6     UB:APO,4
         BEZ      RELC6
         MTB,-1   PB:UC,6           DECR
         STB,5    UB:APO,4               & REL APO
         LB,7     PB:PVA,6          GET VIRT START OF PURE P
         LB,2     PB:PSZ,6          GET # OF PG OF PURE P
         STORE,3  JX:CMAP,7         CLEAR PROC OUT OF USER MAP
         AI,7     1
         BDR,2    %-2
RELC6    EQU      %
*
*        RELEASE CORE EXCEPT COMMON
*
         LI,6     JBBCP
         LB,7     J:JIT,6           TOP PG TO REL
         LB,6     J:JIT,6
         AI,6     1
         SW,6     J:DLL
         BEZ      RELC2
RELC1    EQU      %
         LI,2     1
         CB,2     JB:LMAP,7
         BNE      RELC15
*  REL SAD PG
         MTB,-1   JB:LMAP,7
         LI,2     FPMC
         STORE,2  JX:CMAP,7
         LI,4     3
         BAL,2    T:SAC
         B        %+3
RELC15   EQU      %
         BAL,11   T:RVPI
         NOP
         AI,7     -1
         BDR,6    RELC1
         STW,6    J:DCBLINK
* RESET CORE LIMITS IN JIT
RELC2    LI,6     JBUPVP
         STB,6    JB:TDP
         STW,6    J:DLL
         STW,6    J:PLL
         STW,6    J:DDLL
         STW,6    J:DCBLL
         AI,6     -1
         STW,6    J:DUL
         STW,6    J:PUL
         STW,6    J:DCBUL
         LI,6     0
         STH,6    JB:PCP
         B        *10
         PAGE
PRERR    LB,0     10                GET ERR CODE
         CI,0     4                 IS IT BOF
         BNE      ABORT             NO-REALLY AN ERROR
         AND,8    X1FFFF            WAS IT POSITIONING TO HEADER
         CI,8     PR2
         BNE      ABORT             NO-ITS AN ERROR
         B        PR2               MUST BE 1ST HEADER--OK
CKERR    EQU      %
         LI,12    X'B6'
         B        ABORT6
WRTERR   EQU      %
RDERR    EQU      %
ABORT    EQU      %
         LI,12    X'B5'
         LW,3     Y2
         CW,3     J:CFLGS
         BAZ      ABORT4            NO BUFFER TO RELEASE
         INT,3    TSTACK+1
         LCW,3    3
         MSP,3    TSTACK
         BAL,5    RELBUF
ABORT4   EQU      %
ABORT6   EQU      %
         AND,10   YFF               IN CASE IO ERR SET UP R10
         LW,14    12
         AW,14    10
         LW,6     M:XX              CLOSE M:XX IF IT WAS LEFT OPEN
         CW,6     Y002
         BAZ      ABORT7
         LI,6     M:XX
         LCI      3
         LM,0     CLOSEWD0
         CAL1,1   0
ABORT7   EQU      %
         B        T:ABORTM
         PAGE
*F*
*F*      NAME:    MEMSET
*F*
*F*      PURPOSE: (1) TO INSURE FULL MEMORY ALLOCATION PRIOR TO SAVING
*F*                   A PROGRAM THAT ISSUED AN M:LINK CAL.
*F*
*F*               (2) TO REAQUIRE DATA AND PROCEDURE PAGES WHEN RESTORING
*F*                   THE PROGRAM AS THE RESULT OF AN M:LDTRC CAL.
*F*
*F*      DESCRIPTION:  IF ANY PAGE WAS OBTAINED VIA AN M:CVM CAL THE
*F*               USER IS ABORTED.  IF THE USER DOESN'T OWN THE PAGE
*F*               IT IS OBTAINED FOR HIM.  THIS IS TO INSURE FULL
*F*               MEMORY ALLOCATION TO WRITE OUT THE PROGRAM THAT
*F*               ISSUED THE M:LINK CAL.
*F*
*D*      NAME:    MEMSET
*D*
*D*      CALL:    BAL,11  MEMSET
*D*
*D*      INPUT:   R2 = PAGE # OF LAST PAGE TO CHECK
*D*               R7 = PAGE # OF FIRST PAGE TO CHECK
*D*
*D*      DESCRIPTION:  IF ANY PAGE WAS OBTAINED VIA AN M:CVM CAL THE
*D*               USER IS ABORTED WITH ERROR CODE B5-65.
*D*
MEMSET   EQU      %
         PSW,11   TSTACK            SAVE RETURN
         LI,6     1                 NUMBER OF PAGES FOR M
MEM1     EQU      %
        LOAD,15 JX:CMAP,7
         CI,D4    FPMC              HAVE THE PAGE
         BNE      CHKSAD            MUST NOT BE CVM PAGE
*D*
*D*               IF THE USER DOES NOT OWN A PAGE IN THE SPECIFIED
*D*               AREA THE PAGE IS OBTAINED FOR HIM VIA THE T:GNVPI
*D*               ROUTINE IN MM.
*D*
         LCI      3
         PSM,1    TSTACK
         MTB,1    JB:PCP              TO PASS MM MAX PAGES TEST
         BAL,11   T:GNVPI           INSURE FULL MEMORY ALLOCATION
         BCS,15   NOPAGE            DIDN'T DO OPERATION
         LCI      3
         PLM,1    TSTACK            RESTORE
         MTB,-1   JB:PCP            RESET COUNT
MEM2     EQU      %
         AI,7     1
         CW,7     2                 FINISHED
         BLE      MEM1              NO
         PLW,11   TSTACK            YES-RETURN
         B        *11
*
*
*
CHKSAD   EQU      %
         LB,D4    JB:LMAP,7         GOT WITH SAD CAL
         CI,D4    1
         BNE      MEM2              NO, ALL OK
         LI,10    5
         B        INVALID
*E*
*E*      ERROR:   B5-65
*E*      MESSAGE: PAGE ACQUIRED BY M:CVM ENCOUNTERED
*E*
NOPAGE   EQU      %
         MTB,-1   JB:PCP            RESET COUNT
         LI,10    6
         LCI      4
         PLM,11   TSTACK            GET RETURN
         CI,11    VALID             ACQUIRING PAGES FOR M:LINK
         BG       INVALID           YES-SYSTEM MEMORY MANAGEMENT ERR
*E*
*E*      ERROR:   B5-66
*E*      MESSAGE: OUT OF PHYSICAL PAGES (SYSTEM ERROR)
*E*
EB500    LI,10    6                 SOMETHING STARNGE ABOUT PROG SIZES
         B        INVALID            SO WE CANT RESTORE PROG
*E*
*E*      ERROR:   B5-00
*E*      MESSAGE: LOAD MODULE SIZE EXCEEDS USER LIMIT OR AVAILABLE CORE
*E*
         PAGE
*F*
*F*      NAME:    T:CAL
*F*      PURPOSE: PROCESS THE M:CAL SERVICE TO CONNECT A USER TO
*F*               THE CAL3 INTERRUPT
*F*      DESCRIPTION:  CALLED FROM ALTCP AS THE RESULT OF A CAL1,5
*F*               WITH FPT CODE 6
*******************
*D*
*D*      NAME:    T:CAL
*D*      ENTRY:   T:CAL
*D*      REGISTERS:  ALL ARE VOLATILE
*D*      INPUT:   6-WORD  0 OF FPT FROM THE CAL
*D*               7-ADDRESS  OF FPT+1
*D*               11-EXIT  ADDRESS (TRAPEXIT)
*D*               J:ALB    CAL3 VECTOR WORD IN THE JIT
*D*               J:XPSD   XPSD BLOCK IN THE JIT FOR USER XPSD
*D*               PR:MS    MASTER MODE PRIV. PROCESSOR BIT
*D*               J:UPRIV  USER PRIVELIGE
*D*               J:PPRIV  PROCESSOR PRIVELIGE
*D*      OUTPUT:  J:ALB    POINTS TO J:XPSD FOR CONNECT, TO CAL3PSD
*D*                        FOR DISCONNECT
*D*               J:XPSD   (WORDS 2 AND 3) TARGET XPSD FOR CAL3'S
*D*                        FOR THIS USER
*D*               CC'S     CC1 RESET IF SUCESSFUL, CC1 SET IF BAD
*D*                        ADDRESS PASSED, CC2 SET IF USER NOT PRIVELIGED
*D*                        FOR MASTER MODE/INHIBIT SET
*D*      DESCRIPTION:
*D*               THIS CAL HANDLES USER CONNECTION DIRECTLY TO THE
*D*      CAL3 TRAP. THE CAL3 XPSD INSTRUCTION IN LOW MEMORY
*D*      IS XPSD,10 *J:ALB  J:ALB POINTS TO THE XPSD BLOCK, WHICH
*D*      IS CAL3PSD BY DEFAULT. THIS IS THE NORMAL ROOT HANDLER FOR
*D*      CAL3 INSTRUCTIONS. BY ISSUING THE M:CAL REQUEST, THE USER
*D*      CAN GAIN DIRECT CONTROL OVER THE CAL3 TRAP. THE USER SUPPLIES
*D*      A TARGET PSD, WHICH IS VERIFIED TO INSURE MAPPED EXECUTION,
*D*      AND OTHER LIMITS BASED ON PRIVELIGE, AND STUFFED IN J:XPSD
*D*      WORDS 2 AND 3 IN THE JIT. J:ALB IS THEN POINTED TO J:XPSD,
*D*      SO THAT THE NEXT CAL3 EXECUTED BY THIS USER WILL BE VECTORED
*D*      DIRECTLY TO THE ROUTINE THE USER SPECIFIED. IF THE INSTRUCTION
*D*      ADDRESS GIVEN IN THE CAL WAS LESS THAN X'10', WE INTERPRET IT
*D*      AS A RESET REQUEST, AND RESET J:ALB TO CAL3PSD. J:ALB IS ALSO
*D*      RESET TO CAL3PSD WHEN ASSOCIATING A PROGRAM (ASP/FETCH) AND
*D*      IN PROCESSING M:LINK REQUESTS.
*D*********************************************************************
*
UPSD     DATA     X'F7B1FFFF',X'07000000'   USER SETTABLE PSD BITS
*
T:CAL    EQU      %
         CI,7     X'1FFF0'          FPT IN REGS??
         BANZ     %+3
         AW,7     TSTACK
         AI,7     -15               READJUST IF SO
         LCI      2
         LM,2     0,7               PICK UP THE PSD
         CI,2     X'1FFF0'          IS THIS A RESET REQUEST??
         BANZ     %+4
         LI,2     CAL3PSD           IF SO, RESET J:ALB
         STW,2    J:ALB
         B        RSETCC1           AND RETURN.
         AND,2    UPSD
         AND,3    UPSD+1            MASK OUT ANY FUNNIES IN THE PSD
         OR,2     Y004              AND INSURE MAPPED.
         CW,2     Y008              DOES IT SAY MASTER OR SLAVE??
         BAZ      T:CALM            B/MASTER, CHECK IT OUT.
         CW,3     YFF               IF SLAVE, BETTER NOT SAY INHIBITED..
         BAZ      T:CALS            B/OK, STORE IN THE PSD.
T:CALB   LW,4     Y4                RETURN SETTINC CC2-YOU CANT DO THAT.
         B        SETCC1+1
T:CALS   STD,2    J:XPSD+2          POKE IN THE PSD
         LI,3     J:XPSD
         STW,3    J:ALB             POINT THE XPSD AT IT
         CW,2     Y008              WAS THAT MASTER??
         BANZ     RSETCC1           B/NOPE, RETURN.
         LI,1     QUEUE
         LI,2     QUEUE1            IF MASTER, RETURN ADDRESSES IN
         LI,3     NEWQ              SR1-SR3
         LW,4     TSTACK
         AI,4     -7
         LCI      3
         STM,1    0,4
         B        RSETCC1
T:CALM   LW,0     PR:MS             FOR MASTER MODE, CHECK IF LEGAL
         LW,1     S:CUN             IF TEL IN CONTROL IS SET,
         LH,1     UH:FLG,1          WE CHECK UPRIV INSTEAD OF PPRIV
         CI,1     X'80'             BECAUSE OF GET LOGIC...
         BAZ      %+3               TIC IS NOT SET
         CW,0     J:PPRIV           SEE IF USER CAN DO IT.
         B        %+2
         CW,0     J:UPRIV
         BANZ     T:CALM1           B/YES, BASED ON THAT.
         LB,0     JB:PRIV           IF NOT, HOW 'BOUT ON PRIV??
         CI,0     X'C0'
         BL       SETCC1            B/NOPE, YOU LOSE.
T:CALM1  CI,6     1                 WAS PROTECTED MODE WANTED??
         BAZ      T:CALS            B/NOPE, THAT'S ALL...
         LI,1     1
         STB,1    3                 IF PROTECTED, FORCE WK=1
         BIF,S9   TCALM2
         OR,3     X4                SET MA FOR 560 (AND 6-7)
         B        T:CALS
TCALM2   OR,3     Y008              SET MA FOR SIG9
         B        T:CALS            AND SPLIT.
         PAGE
*
*        M:COUPLE AND M:DECOUPLE CAL HANDLER.
*
*        CAL1,8 FPT
*
*        FPT      DATA X'1D800000'  FOR M:DECOUPLE
*                 DATA X'1D0000LL'  FOR M:COUPLE, LL IS LINE #
*
*        THE DECOUPLE ROUTINE IS IN THE COC MODULE, AND IS CALLED
*        BAL,11   DECOUPLE%
*                 WITH THE LINE # IN R2.
*
*        THESE CALS RETURN THROUGH THE CC SET LOGIC
*
T:COUPL  EQU      %
         LW,0     S:COUP            IS COUPLING ENABLED
         BLE      SETCC1            NOPE. DONT BOTHER.
         LC       J:JIT
         BCR,8    SETCC1            ONLY ONLINE USERS.
         BCS,2    SETCC1            AND NOT RA USERS.
         LI,0     TIE               OK, THEN, IS THE TABLE THERE??
         BLE      SETCC1            NUTS. SPLIT.
         CW,6     Y008              CHECK BIT FOR COUPLE/DECOUPLE
         BANZ     T:DCPL            IF SET, THIS IS DECOUPLE.
         LI,2     X'FF'
         AND,2    6                 COUPLE TO THIS LINE
         CI,2     LNOL-1            IS LINE # LEGAL...
         BG       SETCC12           NO. NUTS TO YOU......
         LC       MODE2,2           IS LINE OFF OR 2741?
         BCS,9    SETCC12           LOOKS LIKE IT......
         LB,1     LB:UN,2           HEY! IS SOMETHING RUNNING
         BE       SETCC12           NOPE. VANISH...
         LC       MODE4,2           IS THIS LINE ACCEPTING?
         BCS,8    T:CPLMM           YES IT IS.
         LI,1     8                 IF THE 8 BIT IN S:COUP IS
         CW,1     S:COUP            SET, THEN WE
         BAZ      SETCC1            ARE REPORTING COUPLE ATTEMPTS.
         DISABLE
         LI,1     X'FF'
         AND,1    M:UC+COCLN        PICK UP OUR LINE #
         STB,1    TIE,2             HEY! THIS GUY TRIED
         LB,1     MODE4,2
         OR,1     X40               TO COUPLE TO YOUR LINE
         STB,1    MODE4,2
         ENABLE
         B        SETCC1            EXIT IN DISGUST.
T:CPLMM  LI,1     3
         DISABLE                    DONT BOTHER ME, I'M BUSY.
         LB,1     M:UC+COCLN,1      GET OUR LINE NUMBER
         LB,0     MODE4,1
         CI,0     X'80'             IS OUR ACCEPT BIT SET...
         BANZ     %+5               YUP. ITS THE X'80' BIT
         STB,1    TIE,1             IF NOT, FIX THINGS UP
         AND,0    MASKS+6           TURN OFF 40 BIT IF IT IS ON
         OR,0     %-4               TURN ON OUR COUPLED BIT
         STB,0    MODE4,1
         LW,4     1                 LET'S SEE IF WE'RE ALREADY COUPLED
         CB,2     TIE,4             TO THIS LINE.
         BE       RSETCC1           B/YES, EXIT HERE.
         CB,1     TIE,4             HAVE WE TRAVERSED THE RING?
         BE       %+3               B/YES, GO COUPLE THEM TOGETHER
         LB,4     TIE,4             PICK UP NEXT THING IN RING
         B        %-5               AND CHECK IT OUT.
         LB,3     TIE,1             ***
         LB,4     TIE,2             ***
         STB,3    TIE,2             *** COUPLE INTO THE RING
         STB,4    TIE,1             ***
         ENABLE                     ***
         LB,6     COCTERM,2         SET UP TRANSLATION TABLE
         LH,10    COCOTV,6          FOR THE TERMINAL,
         BAL,13   COCDSABL          DONT BOTHER ME........
         LI,4     20                MESSAGE LENGTH
         LI,3     0                 A POINTER
T:CPLMS  LB,5     T:CPLM,3          LOAD THE CHARACTER
         PUSH     2,3
         BAL,9    COCPCIB           AND SEND IT TO THEM
         PULL     2,3
         AI,3     1
         BDR,4    T:CPLMS
         LW,5     1
         SLS,5    -4
         LB,5     HEX,5             LOAD AND PRINT THE LINE
         BAL,9    COCPCIB           NUMBER
         LI,5     X'F'
         AND,5    1
         LB,5     HEX,5
         BAL,9    COCPCIB
         LI,4     4
         CW,4     S:COUP            IF THE 4 BIT IS SET,
         BAZ      T:CPLM2           BUT IT ISNT.
         LI,5     X'40'             IF IT IS,
         BAL,9    COCPCIB           SEND OUT A SPACE
         LI,3     0
         LI,4     8                 FOLLOWED BY THE ACCOUNT
T:CPLM1  LB,5     J:ACCN,3          NUMBER OF THE GUY ISSUING
         PUSH     2,3
         BAL,9    COCPCIB           THE COUPLE CAL.
         PULL     2,3
         AI,3     1
         BDR,4    T:CPLM1
T:CPLM2  BAL,D4   ECHOCR
         BAL,13   COCENABL          WAKE UP.......
         B        RSETCC1           ALL DONE......
T:DCPL   EQU      %                 DECOUPLE CODE
         BAL,5    COCGLN            GET COC LINE # IN R2
         B        RSETCC1           B/NOT ONLINE, OR .FF LINE #
         BAL,11   DECOUPLE%         AND DECOUPLE THE LINE
         B        RSETCC1           ALL DONE
*
*
T:CPLM   DATA     X'0D0707C3'
         TEXT     'OUPLE FROM LINE ' COUPLE MSG SENT TO TERMINALS
*
SETCC12  LW,4     YC
         B        SETCC1+1
*
*
         DO       20
         DATA     0
         FIN
         END      LDSTART

