*        CREATED 12/29/71  PJH
         SYSTEM   UTS
         CSECT    0
         DEF      LNKTRC
LNKTRC   EQU      %
         B        LDSTART
         REF      T:ABORTM
         REF      J:JIT,T:TOTESZ
         REF      J:PLL,J:PUL,J:DLL,J:DUL,J:DDLL,J:DDUL
         REF      J:BUP
         REF      JBBCP
XFFFE    EQU      NB31TO0+1
         REF      JB:TDP
         REF      JBPCDD
         REF      J:DCBLINK
         REF      J:RNST
         REF      JX:CMAP
         REF      JBUPVP
         REF      JB:BCP,J:ABUF
         REF      J:DCBLL,J:DCBUL
         REF      SBUF1VPA,SBUF2VPA
         REF      T:GBUF,T:RBUF,T:ZBUF
         REF      JIT,ERO
         REF      YFF
         REF      J:INTENT
         REF      J:TIMENT
         REF      J:UTIMER
         REF      J:USENT
         REF      J:TCB
         REF      J:TREE
         REF      J:CFLGS
         REF      J:ASSIGN
         REF      JB:PCP
         REF      JB:LMAP
         REF      J:ACCN
         REF      M:XX
         REF      UH:FLG
         REF      UB:DB,UB:ASP,UB:APR,UB:APO
         REF      P:NAME
         REF      PB:UC
         REF      P:SA
         REF      PB:PSZ,PB:PVA
         REF      S:CUN
         REF      T:ASP
         REF      T:REG
         REF      T:RVPI
         REF      T:GNVPI
         REF      T:PAC
         REF      E:AP
         REF      Y008
         REF      FPMC
         REF      PB:REP
         REF      DCBCHK#
         REF      STEPOVRSEG
*
*
*        FORMAT OF EACH SET OF RECORDS IN IDN CONSECUTIVE FILE
*
* HEADER      2 WORDS-ID0N / 0
* RECORD 1    JIT INFORMATION RECORD
* RECORD 2    DCBS (IF ANY)
* RECORD 3    DATA (IF ANY)
* RECORD 4    PROCEDURE + DD OR DD ONLY (IF ANY)
* TRAILER     2 WORDS-ID0N / # OF RECORDS PRECEEDING TRAILER
*
*
         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    PURE PROCEDURE SIZE
* WORD 16    DCB SIZE  (SIZE OF RECORD 2)
* WORD 17    DATA SIZE  (SIZE OF RECORD 3)
* WORD 18    PURE PROCEDURE SIZE + DYNAMIC DATA SIZE
*                   (SIZE OF RECORD 4 IF UNSHARED PROGRAM RUNNING)
* WORD 19    DYNAMIC DATA SIZE
*                   (SIZE OF RECORD 4 IF SHARED PROCESSOR RUNNING)
*
*
*        BUFFER FOR HEADER AND TRAILER RECORDS
*
* WORD FE    ID0N-IDENTIFIES SET OF RECORDS
* WORD FF     # RECORDS IN SET (0 IF HEADER)
*
*
*
* SECOND HALF PAGE        CONTAINS THE USERS ENVIRONMENT AND THE FPT
*
* WORD 100-103    USERS PSD
* WORD 104-112    USERS REGISTERS 0-15
* WORD 113-119    M:LINK OR M:LDTRC FPT
*
*
* 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
TDPDISP  EQU      20
PRSZDISP EQU      21
DCBSDISP EQU      22
DSZDISP  EQU      23
PDDSDISP EQU      24
DDSDISP  EQU      25
JINFOSZ  EQU      4*26              SIZE OF JIT INFO
         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
BLANKS   TEXT     '      '
M24      DATA     X'00FFFFFF'
X1FFFF   DATA     X'1FFFF'
XFFFF    DATA     X'FFFF'
YC       DATA     X'C0000000'
Y8       DATA     X'80000000'
Y4       DATA     X'40000000'
Y2       DATA     X'20000000'
Y003E    DATA     X'003E0000'
Y03      DATA     X'03000000'
Y002     DATA     X'00200000'
YFFFFFF  DATA     X'FFFFFF00'
         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
*
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
*
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
*************************************
*        LOAD & LINK                *
*        LOAD & TRANSFER CONTROL    *
*        CLEAN UP AT EXIT TIME      *
*************************************
*
*        6  = 1ST WD OF PLIST
*        7  = PLIST+1 ADR
*        8  = CODE  02=M:LINK  03=M:LDTRC
*
*  GO TO EITHER LINK OR LDTRC OR LEXIT
LDSTART  EQU      %
         PUSH     11
         PUSH     2,6
         CI,8     2                 IS IT LOAD & LINK
         BE       LNK0              YES
         CI,8     3                 IS IT LOAD & TRANSFER CONTROL
         BE       LDT0              YES
         B        LEXIT             MUST BE EXIT LOGIC
*
*        LINK
*
LNK0     EQU      %
         BAL,11   TRUNK
         BAL,5    VALID
         BAL,5    MOVEFPT
*  TRUNCATE FILES - IO RUNDOWN
         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
*  CREATE & OPEN FILE NAMED 'IDN'
         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,9    SBUF1VPA+X'100'+3+8
*                                   FILE NAME TO USERS SR1
         LI,10    1
         LCI      2
         STM,9    SBUF1VPA+X'FE'
         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
LNK1     EQU      %
*  SAVE SPECIAL JIT VALUES IN BUFFER
         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
         LCI      6
         STM,8    SBUF1VPA+INTEDISP PUT VALUES IN BUFFER
* SAVE PSD IN BUFFER
         LD,6     SBUF1VPA+X'100'   GET PSD FROM USERS ENVIRONMENT
         LCI      2
         STM,6    SBUF1VPA+PSDDISP  USER PSD TO BUFFER
* SAVE JIT MEMORY DELIMITER IN BUFFER
         LCI      8
         LM,6     J:BUP
         LD,14    J:DCBLL
         LCI      10
         STM,6    SBUF1VPA+BUPDISP
*  PROCESSOR #S & FLGS IN
         BAL,5    PROCFLG           6=APR,APO,ASP&DB  7=FLAGS
* GET TOP DYNAMIC PAGE
         LB,8     JB:TDP
         BNEZ     %+2               IF = 0 ITS AN EXTENDED USER WITH
         LI,8     X'100'             DD TO THE TOP OF VIRTUAL CORE
* COMPUTE SIZES
         SW,9     J:PLL             PUL-PLL
         AI,9     1                  +1 = PROC SIZE
         SW,11    J:DLL             DUL-DLL
         AI,11    1                  +1 = DATA SIZE
         SW,15    J:DCBLL           DCBUL-DCBLL
         AI,15    1                  +1 = DCB SIZE
         STW,15   10                PACK THEM UP
         LW,12    8                 TDP-PLL = RECORD SIZE
         SW,12    J:PLL              (FOR USE IF USER RUNNING)
         LW,13    8                 TDP-DLL = RECORD SIZE
         SW,13    J:DDLL             (FOR SHARED PROC RUNNING)
*  PUT TO BUFFER
         LCI      8
         STM,6    SBUF1VPA+PRFLDISP
         AI,10    0                 ANY DCBS
         BEZ      %+2               NOPE
         MTW,1    SBUF1VPA+X'FF'
         AI,11    0                 ANY DATA
         BEZ      %+2               NOPE
         MTW,1    SBUF1VPA+X'FF'
         LB,8     6                 SHARED PROCESSOR RUNNING
         BEZ      %+2               NO-USE R12
         LW,12    13                GET SIZE OF RECORD 4
         AI,12    0                 IS THERE A 4TH RECORD
         BEZ      %+2               NO
         MTW,1    SBUF1VPA+X'FF'
         LI,4     0
         XW,4     SBUF1VPA+X'FF'
         LI,0     SBUF1VPA+X'FE'
         LI,1     8                 2 WORDS
         BBLC     5                 FAKE BFR CHKR
         CAL1,1   WRITE             NAME & A WORD OF ZERO
         STW,4    SBUF1VPA+X'FF'    # OF RECORDS FOLLOWING
*
*        WRITE JIT INFORMATION RECORD
*
         LI,0     SBUF1VPA          BUFFER
         LI,1     JINFOSZ           SIZE
         BBLC     5
         CAL1,1   WRITE
*
*        WRITE DCBS
*
         LW,1     10                # PAGES OF DCBS
         BEZ      LNK5
         LW,0     J:DCBLL           BUF FOR DCBS
         SLD,0    9                 BUF = BEG OF DCBS
         SLS,1    2                 SIZE IN BYTES
         CAL1,1   WRITE
*
*        WRITE DATA
*
LNK5     LW,1     11                # PAGES OF DATA
         BEZ      LNK6
         LW,0     J:DLL             BUF FOR DATA
         SLD,0    9
         SLS,1    2
         CAL1,1   WRITE
*
*        WRITE REST OF PROG
*
LNK6     LW,0     J:PLL             BUF IF USER IS RUNNING
         LW,1     12                PROC SZ + DD SZ
         LB,8     6                 IS THERE APR SO NO PURE P
         BEZ      %+3               NO, WRITE ALL
         LW,0     J:DDLL            YES, DONT WRITE PROCEDURE
         LW,1     13                DD SIZE
         AI,1     0                 ANYTHING TO WRITE
         BEZ      LNK7              NO
         SLD,0    9
         SLS,1    2
         CAL1,1   WRITE
LNK7     BBLC     1                 FAKE BFR CHKR
         LI,0     SBUF1VPA+X'FE'
         LI,1     8                 2 WORDS
         CAL1,1   WRITE             NAME & # OF RECORDS
*  CLOSE & SAVE FILE
         LI,4     M:XX
         LCI      3
         LM,0     SHUTDCB
         CAL1,1   0
*  RELEASE CORE
LNK7RLCO BAL,10   RELCORE           RELEASE PROCS & CORE
         B        L10LNK            GET LOAD MODULE & GO
         PAGE
*************************************
*                                   *
*************************************
LDT0     EQU      %
         BAL,11   TRUNK
         BAL,5    VALID
LDT02    EQU      %
         BAL,5    MOVEFPT
*
*        CLOSE ALL OPEN DCBS
         LI,4     0
         STW,4    J:INTENT
         STW,4    J:TIMENT
         STW,4    J:UTIMER
         STW,4    J:USENT
         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
         BAL,11   CLOSE
*  RELEASE CORE
         BAL,10   RELCORE           REL PROCS & CORE
         LW,13    *TSTACK           POINTER TO NAME
*  DETERMINE WHETHER LM WAS PREV SAVED IDN
         LB,2     *13               BYTE CNT OF NAME
         CI,2     3
         BNE      L10LNK            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      L10LNK            NO
*
*        GET PREV SAVED LM          *
*
*  GET FPT INTO REGS & OPEN FILE UPDATE
*
         LCI      11
         LM,0     OPNFPT
         LW,9     *13               GET LMN INTO FPT
         AND,9    YFFFFFF
         AI,9     'N'               MAKE IT IDN
         REF      J:STAR
         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
         LW,3     TSTACK
         LW,2     0,3               POINTER TO NAME
         LW,2     0,2               ID NAME
         LI,1     0                 SET FLAG FOR
         STW,1    SBUF1VPA+X'FD'     ANY FILES LEFT
LP       BBLC     1                 FAKE BFR CHKR
         LI,0     SBUF1VPA+X'FE'
         LI,1     8                 2 WORDS
         CAL1,1   READR             READ REVERSE
         LW,1     SBUF1VPA+X'FF'
         BNEZ     PR
         MTW,1    SBUF1VPA+X'FD'    CAN'T RELEASE IDN
         B        LP
PR       LCI      4
         LM,3     PREC              POSITION REVERSE
         CAL1,1   3                 # OF RECORDS IN R1
         CW,2     SBUF1VPA+X'FE'    CHK 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,0     SBUF1VPA+X'FE'
         BBLC     1
         LI,1     8                 2 WORDS
         CAL1,1   READ              READ HEADER
         CW,2     SBUF1VPA+X'FE'
         BNE      RDERR
         LW,0     SBUF1VPA+X'FF'
         BNEZ     RDERR
         LCI      2
         LM,0     DELREC
         CAL1,1   0                 DON'T READ AGAIN
*
*  GET JIT INFO INTO BUFFER
*
         LI,0     SBUF1VPA          BUFFER ADDRESS
         LI,1     JINFOSZ           SIZE OF JIT INFO
         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
         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,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
*  GET PGS FOR DCBS & READ THEM IN
         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
         LW,1     6
         LW,0     J:DCBLL
         SLD,0    9                 DCB BUF
         SLS,1    2                         % SIZE
         BBLC     3
         CAL1,1   READ
* GET PAGES AND RESTORE DATA
LDT3     LW,7     J:DLL             BUFFER FOR DATA
         LW,6     SBUF1VPA+DSZDISP  # PAGES OF DATA
         BEZ      LDT35
         BAL,11   T:GNVPI           GET THE DATA PAGES
         LW,1     6                 SIZE
         LW,0     J:DLL
         SLD,0    9
         SLS,1    2
         BBLC     3
         CAL1,1   READ
LDT35    EQU      %
         LW,8     SBUF1VPA+PRFLDISP GET PROCESSOR WORD
         LB,9     8                 GET APR
* IF RESTORING USER GET PROCEDURE AND DYN DATA
         LW,7     J:PLL
         LW,6     SBUF1VPA+PDDSDISP SIZE OF PROC + DD
         BEZ      LDT6
         CI,9     0                 IS THERE APR
         BEZ      LDT4              NO, GET PGS FOR ALL & READ ALL
         LW,7     J:DDLL
         LW,6     SBUF1VPA+DDSDISP  SIZE OF DD ONLY
         BEZ      LDT6              THERE ISNT ANY
LDT4     EQU      %
         BAL,11   T:GNVPI
         LW,0     J:PLL
         CI,9     0                 IS THERE APR
         BEZ      %+2               NO
         LW,0     J:DDLL
         LW,1     6
         SLD,0    9                 BEG OF DATA = BUFFER
         SLS,1    2                 SIZE
         LI,11    0
         LB,10    JB:PCP
         STB,11   JB:PCP            TO PREVENT PURE P SWAPPED TIL READ
         BBLC     3
         CAL1,1   READ              READ DATA & POSSIBLY REST
         LW,2     S:CUN
         LH,3     UH:FLG,2
         OR,3     X10               SET PPSWP BIT, NOW IF USER IS
         STH,3    UH:FLG,2          SWAPPED, EVERYTHING WILL GO OUT
         STB,10   JB:PCP            & PURE P CNT CAN BE RESTORED
*  RESTORE NEXT AVAILABLE DYN PG VALUE
LDT6     EQU      %
         LW,10    SBUF1VPA+TDPDISP  GET TOP DYN PAGE
         STB,10   JB:TDP            & PUT INTO JIT
*  ALL CORE RESTORED
*
*  CLOSE & RELEASE IDN
         LI,6     M:XX
         LCI      3
         LM,0     CLOSEWD0
         LW,10    SBUF1VPA+X'FD'    ANY FILES LEFT
         BNEZ     LDT7              YES, DON'T RELEASE
         LI,10    X'FF'             DID WE GET TO 1ST
         AND,10   SBUF1VPA+X'FE'
         BNEZ     LDT7              NOPE
         LI,11    X'FF'             RESET COUNTER
         STS,10   J:RNST
         LI,2     1                 REL
LDT7     CAL1,1   0                 CLOSE IDN
*  MOVE PSD FROM BUFFER INTO USERS ENVIRONMENT
         LCI      2
         LM,10    SBUF1VPA+PSDDISP  GET USER PSD FROM BUFFER
         OR,10    Y008              FORCE SLAVE MODE
         STD,10   SBUF1VPA+X'100'   PSD TO USER ENVIRONMENT
         LI,5     X'FF'
         AND,5    8                 GET ASP-CORE LIBRARY
         BEZ      LDT8              ISNT ANY
*  REASSOCIATE CORE LIB
         LW,4     S:CUN
         STB,5    UB:ASP,4          PROC # TO USER TABLE
         LI,7     0                 PHONEY PAGE NUMBER
         BAL,0    T:TOTESZ          FIND SIZE IF ASP IS ASSOCIATED
         B        NOCORE            TOO BIG
         LW,2     9                 IS THERE APR
         BNEZ     LDT85             YES-STEP WILL REG FOR LIBRARY
         MTB,1    PB:UC,5           INCREASE PROCESSOR USE COUNT
         LW,2     S:CUN
         LH,3     UH:FLG,2
         AND,3    XFFFE             RESET READY TO RUN
         STH,3    UH:FLG,2
         LI,6     E:AP
         BAL,11   T:REG
         BAL,11   T:PAC
LDT8     EQU      %
*  IF APR, GET NAME
         LW,2     9                 IS THERE APR
         BEZ      LDT9              NO
LDT85    EQU      %
         LD,6     P:NAME,2
         LW,13    SYSACT            SYS ACCT #
         LW,14    SYSACT+1
         LI,10    0                 NO PASSWD
         LI,11    0
*  SO ASP WILL ASSOC CORRECT OVERLAY, PUT 1 TO RESTORE IN J:CFLGS
         MTW,1    SBUF1VPA+X'100'   BUMP USERS 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        L12               SET UP TEMP STK & GO TO ASP
*  ONLY RESTORING USER (NO APR) SO GO TO HIM VIA CAL EXIT
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
*   GET A BUFFER FOR THE DCB CHECKER
         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
LDT95    EQU      %
         BCS,3    ILLEGAL
         PULL     2,2               BUMP STACK -2
         PULL     11
         BAL,5    RELBUF
         LW,4     TSTACK
         LW,5     J:TCB
         STW,5    -15,4
         DESTRUCT
         PAGE
*  PROC OR LM NEEDED - SET ENVIR & GO TO ASP
*  REG 6,7,8=NAME  13,14=ACCT  10,11=PASSWD
*
L10LNK   EQU      %
*  SET BIT 1 OF J:CFLGS TO INDICATE TO T:ASP IT IS LDLNK  IE. NEW
         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
*  GET NAME INTO 6,7&8 FROM PLIST
         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
*  GET ACCT INTO 13&14
         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      %
*  GET PASSWD INTO 10&11
         LI,10    0
         LI,11    0
         CI,4     1
         BAZ      L12
         LW,10    0,5               GET
         LW,11    1,5                   PASSWD
L12      EQU      %
*  MOVE NAME,ACCT# & PASSWD FROM REGS TO TSTACK - 2ND ENVIRON FOR ASP
         PULL     4                 PULL EXIT ADR - NOT NEEDED
         BAL,5    RELBUF
         BUMP     19,4              SPACE FOR 2ND ENVIRON
         LW,4     TSTACK            POINTS TO REG 15 OF ASP ENVIRON
         LCI      3
         STM,6    6-15,4            NAME TO STACK
         LCI      2
         STM,13   13-15,4           ACCT #
         LCI      2
         STM,10   10-15,4           PASSWD
         LI,2     0                 DEBUGGER NAME
         STW,2    0-15,4
* RELEASE FPOOLS
         PUSH     16,0
         BAL,6    T:ZBUF
         PULL     16,0
         LI,2     0
         LW,3     Y003E
         STS,2    J:RNST
         LI,11    T:ASP
         B        T:SELFDESTRUCT
         PAGE
*************************************
*        EXIT,ERR, OR ABORT         *
*        CLOSE DCBS & REL IDN FILES *
*************************************
LEXIT    EQU      %
*  CHECK TO MAKE SURE ITS EXIT
         LI,9     X'FF'
         AND,9    J:RNST
         OR,9     Y8
         CW,8     9                 IS THIS EXIT
         BE       %+3               YES
         LI,10    7                 NO, NOT EXIT
         B        INVALID
         LB,10    J:RNST
         PUSH     10                SAVE BYTE 0 OF RNST
         LW,10    M24
         AND,10   J:RNST
         STW,10   J:RNST            ZAP BYTE 0
* GET A BUFFER FOR READING JIT INFORMATION
         LI,14    SBUF1VPA
         BAL,2    T:GBUF
*  SAVE THE ERROR CODE AS J:ERO WILL BE DESTROYED BY
*  THE ERR RETURN USED FOR M:XX.
         LW,4     JIT+ERO
         STW,4    SBUF1VPA+X'100'
         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
*  CREATE IDN FILE NAME,  START WITH N=0
         LW,9     J:JIT
         AND,9    XFFFF
         SLS,9    8
         OR,9     Y03
*  CHECK FOR DONE, IF NOT OPEN IDN
         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
LEX65    EQU      %
         BBLC     1
         LI,0     SBUF1VPA+X'FE'
         LI,1     8                 2 WORDS
         CAL1,1   READF             READ THE HEADER
         LW,1     SBUF1VPA+X'FE'    CHK 4 HEADER
         SLS,1    -8
         LI,2     X'FFFF'
         AND,2    J:JIT
         AI,2     X'30000'
         CW,2     1
         BNE      LEX1              NO HIT
         LW,1     SBUF1VPA+X'FF'
         BNEZ     LEX65
*
*  GET JIT INFO INTO BUFFER
         LI,0     SBUF1VPA
         LI,1     JINFOSZ           SIZE
         BBLC     3
         CAL1,1   READF
         LI,1     PRFLDISP*4        BYTE DISP TO PROCESSOR WORD
         LB,2     SBUF1VPA,1
         MTB,-1   PB:REP,2          APR
         AI,1     2                 DONT DO APO
         LB,2     SBUF1VPA,1
         MTB,-1   PB:REP,2          ASP
         AI,1     1
         LB,2     SBUF1VPA,1
         MTB,-1   PB:REP,2          DB
* GET THE PAGES TO READ THE DCBS
         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
* READ THE DCBS
         LW,1     SBUF1VPA+DCBSDISP # PAGES OF DCBS
         LW,0     J:DCBLL
         SLD,0    9                 BUF
         SLS,1    2                 SIZE
         BBLC     3
         CAL1,1   READ
         SLS,1    -11               # DCB PGS
         BAL,12   CKDCBS
         BCS,3    %+2
         BAL,11   CLOSE             CLOSE ALL OPEN DCBS
* RELEASE DCB PAGES
         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    %-2
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
*
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
*
LEX9     EQU      %
*  DONE WITH ALL FILES
         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
*  RESTORE J:ERO
         LW,4     SBUF1VPA+X'100'
         STW,4    JIT+ERO
*  RESTORE BUFFER
         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
*
*
ILLEGAL  EQU      %
         LI,10    8
         B        INVALID           00B568 ERROR CODE
         PAGE
*************************************
*        CHECK FOR VALID CONDITIONS *
*        PERMITTING LDLINK & LDTRC  *
*************************************
*
VALID    EQU      %
*  DEBUGGER NOT ALLOWED
         LW,1     S:CUN
         LB,2     UB:DB,1
         BEZ      %+3               NO DEBUGGER - OK
         LI,10    1
         B        INVALID
*  AN ASP WHICH ISNT A CORE LIB NOT ALLOWED
         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
VALID3   EQU      %
*  PROGRAM CREATED BY LINK NOT ALLOWED INDICATED BY DD BELOW PURE P
         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
         BE       %+3               DD>PUR P= OLAY LOADER - OK
VALID4   EQU      %
         LI,10    3
         B        INVALID
*  PROG WHICH HAS DONE VP CALS NOT ALLOWED  INDICATED BY
*  COMMON + DYNAMIC PGS NOT = DD PG CNT
         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       %+3
         CI,5     LDT02
         BNE      VALID6
         PSW,5    TSTACK                                        #6123
         LI,3     J:DLL             INSURE FULL MEMORY ALLOCATIO#6123
         LW,2     J:DUL             FOR DATA AND PP             #6123
         BAL,11   MEMSET                                        #6123
         LI,3     J:PLL                                         #6123
         LW,2     J:PUL                                         #6123
         BAL,11   MEMSET                                        #6123
         LI,3     J:DCBLL
         LW,2     J:DCBUL
         BAL,11   MEMSET
         PLW,5    TSTACK                                        #6123
         LD,2     J:DLL
         LI,1     FPMC
VALID5   EQU      %
         CW,2     3
         BGE      VALID7
         COMPARE,1 JX:CMAP,2
         BE       VALID6
         AI,2     1
         B        VALID5
VALID6   EQU      %
         LI,10    4
         B        INVALID
VALID7   EQU      %
         B        *5                ALL VALID - EXIT
INVALID  EQU      %
         AI,10    X'60'
         SCS,10   -8
         B        ABORT
NOCORE   STB,7    UB:ASP,4          BECAUSE WE CANT ASSOCIATE IT
         LI,10    X'6D'
         B        INVALID+1
NOCORE2  LI,10    7
         B        INVALID+1
         PAGE
***********************************************
*        MOVE FPT FROM USER AREA TO TSTACK
***********************************************
MOVEFPT  EQU      %
         PUSH     5
         LI,14    SBUF1VPA
         BAL,2    T:GBUF
         PULL     5
         PULL     2,6               GET WORD 0 OF FPT AND POINTER TO WD1
         PULL     4                 GET EXIT ADDRESS
         LW,3     Y2                FLG INDIC BUFFER USE
         STS,3    J:CFLGS
         LI,3     SBUF1VPA+X'FF'
         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      7
         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
*
*   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,15    SBUF1VPA+X'FF'
         LW,9     *15,2
         STW,9    TSTACK+1,2
         BDR,2    %-2
*   RELEASE THE BUFFER
         PUSH     4,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     4,11
         B        *5
         PAGE
*************************************
*  TRUNK- TRUNCATES ALL OPEN FILES  *
*  CLOSE- CLOSES    ALL OPEN FILES  *
*************************************
*
CLOSE    EQU      %
         LW,0     CLOSEWD0          CLOSE FPT-DCB ADR IN R6
         LI,2     0                 INDICATES TO CLOSE
         LI,1     0                 NO OTHER PARAMETERS IN FPT
         B        TRUNK0
TRUNK    EQU      %
         LI,2     -1                INDICATES TO TRUNCATE
TRUNK0   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
         CI,2     -1                IS IT TRUNK
         BG       CLOSE4            NO, CLOSE
         LCI      2
         LM,0     TRUNKFPT
         CAL1,1   0
         LCI      4
         LM,0     CHECKFPT
         CAL1,1   0
         LI,2     -1
         B        TRUNK2
CLOSE4   EQU      %
         LI,2     TRUNK2
         LI,3     X'1FFFF'
*  SET ERR & ABN IN DCB
         STS,2    3,6
         STS,2    4,6
         LI,2     0
         CAL1,1   0                 CLOSE FPT IN REGS 0,1,2
         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      %
         LW,4     S:CUN
         LI,5     0
         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
         REF      T:SAC
         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
MEMSET   EQU      %
*
*        MEMSET GETS ALL PAGES BETWEEN LOWER LIMIT IN *R3
*        AND THE PAGE SPECIFIED IN R2; RELEASING ALL PAGES
*        BETWEEN (R2)+1 AND THE UPPER LIMIT *R3+1
*
         PSW,11   TSTACK            SAVE RETURN
         LCI      2
         PSM,0    TSTACK
         PSW,6    TSTACK
         LI,6     1                 NUMBER OF PAGES FOR M
         LW,7     *3                LOWER LIMIT
         LI,1     0                 INDICATING GET OPERATION
         BAL,10   MEM1
         CW,7     *3,1              GREATER THAN UPPER LIMIT
         BG       MEMDONE           YES
         LI,1     1                 INDICATING RELEASE
         LI,2     0
         LI,10    X'60000'
         CW,10    J:ASSIGN          IS THERE DEBUG PG
         BCR,4    %+2               NO
         LI,2     -1                ACCT FOR IT
         AW,2     *3,1
         CW,2     7                 BUMP OVER PAGE YET
         BL       MEMDONE           YEP, QUIT
         BAL,10   MEM1
MEMDONE  EQU      %
         PLW,6    TSTACK
         LCI      2
         PLM,0    TSTACK
         PLW,11   TSTACK
         B        *11               RETURN
*
*
MEM1     EQU      %
        LOAD,15 JX:CMAP,7
         CI,D4    FPMC              HAVE THE PAGE
         EXU      ACTION,1          TREAT APPROPRIATELY
         LCI      3
         PSM,1    TSTACK
         MTB,1    JB:PCP              TO PASS MM MAX PAGES TEST
         BAL,11   GETFREE,1         GET/RELEASE ENTRYS
         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
         B        *10               YES, RETURN
*
*
ACTION   BNE      CHKSAD
         BE       MEM2
*
GETFREE  B        T:GNVPI
         B        T:RVPI
*
*
*
CHKSAD   EQU      %
         LB,D4    JB:LMAP,7         GOT WITH SAD CAL
         CI,D4    1
         BNE      MEM2              NO, ALL OK
         LI,14    SADPAGE
         B        ABORTIT
*
*
NOPAGE   EQU      %
         MTB,-1   JB:PCP            RESET COUNT
         LI,14    SANSPAGE
         B        ABORTIT
*
ABORTIT  EQU      %
         SCS,14   -8
         AI,14    X'B1'
         B        T:ABORTM
*
SANSPAGE EQU      6
SADPAGE  EQU      7
D4       EQU      15
         DO       20
         DATA     0
         FIN
         END      LDSTART
		 