Retro1.org codex

          IDENT  SYSEDIT,DSL 
          ABS
          SST    T1,T2,T3,T4
          ENTRY  SYSEDIT
          ENTRY  RFL=
          ENTRY  SSJ=
          SYSCOM B1
 QUAL$    EQU    1           DEFINE UNQUALIFIED COMMON DECKS
*COMMENT  SYSEDIT - SYSTEM LIBRARY FILE MANAGER.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  SYSEDIT - SYSTEM LIBRARY FILE MANAGER.
          SPACE  4
***       SYSEDIT - SYSTEM LIBRARY FILE MANAGER.
*         G. R. MANSFIELD.  70/12/19.
*         P. D. HAAS.       73/02/09.
          SPACE  4
***              SYSEDIT PERFORMS MODIFICATIONS AND INITIALIZATION
*         OF THE SYSTEM LIBRARY.
          SPACE  4
***       CONTROL CARD CALL.
*
*
*         SYSEDIT (P1,P2,...,PN)
*
*         PN                 ACTION
*
*         I                  DIRECTIVE INPUT FROM FILE *INPUT*
*         I=LFN              DIRECTIVE INPUT FROM FILE *LFN*
*         I=0                NO DIRECTIVE INPUT
*
*         B                  BINARY CHANGE RECORDS FROM FILE *LGO*
*         B=LFN              BINARY CHANGE RECORDS FROM FILE *LFN*
*         B=0                NO BINARY CHANGE RECORDS
*
*         L                  LIST OUTPUT ON FILE *OUTPUT*
*         L=LFN              LIST OUTPUT ON FILE *LFN*
*         L=0                NO LIST OUTPUT
*
*         R                  RESTORE TO INITIAL DEAD START SYSTEM.
*         R=N                RESTORE TO COPY N OF SYSTEM
*                            THE SYSTEM COPY NUMBER IS PRINTED ON THE
*                            OUTPUT LISTING.
*         R=0                NO SYSTEM FILE RESTORATION
*
*         C                  CHECKPOINT SYSTEM AT JOB COMPLETION
*
*         Z                  READ DIRECTIVES FROM THE SYSEDIT CARD.
*                            THIS OVERRIDES ANY *I* PARAMETER.
*
*         NA                 NO ABORT TAKEN IF SYSTEM FILE IS BUSY.
*
*
*         DEFAULT PARAMETERS.
*
*         I=INPUT
*         L=0
*         B=LGO
*         R=0
*         C                  SELECTED IF ALTERNATE LIBRARY PRESENT
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*         *DIRECTIVE ERRORS.*
*
*         * ERROR IN LIBDNN*
*
*         *MEMORY OVERFLOW.*
*
*         *RECORD NOT FOUND.*
*
*         *REQUESTED RESTORATION NOT FOUND.*
*
*         *SYSEDIT ARGUMENT ERROR.*
*
*         *SYSTEM BUILT WITH LIBDNN.*
*
*         *SYSTEM BUILT WITH LIBDNN (UNDEFINED).*
*
*         *SYSTEM EDIT COMPLETE - CHANGE NN.*
*
*         *SYSTEM FILE ERROR IN CLD.*
*
*         *SYSTEM FILE ERROR IN DIRECTORY.*
*
*         *SYSTEM FILE ERROR IN PLD.*
*
*         *SYSTEM FILE ERROR IN RCL.*
*
*         *SYSTEM FILE ERROR IN RPL.*
*
*         *SYSTEM FILE FORMAT ERROR.*
*
*         / TERMINAL INPUT NOT VALID. USE *I* OR *Z* OPTION./
          SPACE  4,10
***       OPERATOR MESSAGES.
*
*         * COPYING XXXXXXX*
*
*         *SKIPPING XXXXXXX*
*
*         *GENERATING LIBRARY DIRECTORY.*
*
*         *LIBDECK NOT FOUND - (NAME)*
          SPACE  4,10
****      ASSEMBLY CONSTANTS.
 
 
 IBUFL    EQU    101B        INPUT BUFFER LENGTH
 LBUFL    EQU    80          LINE BUFFER LENGTH
 OBUFL    EQU    2001B       OUTPUT FILE BUFFER
 FBUFL    EQU    10001B      FILE BUFFER
 SBUFL    EQU    30001B      SYSTEM BUFFER
 MINC     EQU    400B        MEMORY INCREMENT
****
          SPACE  4
**        COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMCMTM
*CALL     COMSMSC
*CALL     COMSPRD
*CALL     COMSSRT
*CALL     COMSSSD
*CALL     COMSSSJ
          TITLE  MACRO DEFINITIONS.
 KEYWD    SPACE  4
**        KEYWD - PROCESS KEYWORD.
*
*
*         KEYWD  NAME,ADDRESS
*         GENERATE LIST AND CALL FOR DIRECTIVE TRANSLATION.
*         ENTRY  *NAME* = KEYWORD NAME.
*                *ADDRESS* = PROCESSOR ADDRESS.
*
*         CALLS  CKW.
 
 
          NOREF  .X
 KEYWD    MACRO  NAM,ADR
          LOCAL  A,B,C
          IF     DEF,.X,1
 .1       IFNE   .X,*,
 KEYWD    RMT
 A        BSS    0
 KEYWD    RMT
          SA0    A
          RJ     CKW
 B        BSS    0
 .X       SET    B
 .1       ENDIF
 KEYWD    RMT
 C        SET    ADR NAM
          CON    0L_NAM+C
 KEYWD    RMT
          ENDM
 PRINT    SPACE  4
**        PRINT - PRINT LINE ON OUTPUT FILE.
*
*
*         PRINT  FWA,N
*         ENTRY  *FWA* = FWA OF LINE.
*                *F* = FORMAT.
*                IF *F* IS MISSING, LINE IS IN *C* FORMAT.
*                IF *F* IS PRESENT, LINE IS IN *S* FORMAT.
*
*         CALLS  WOF.
 
 
 PRINT    MACRO  FWA,N
          R=     X1,FWA
          IFC    NE,*N**,1
          R=     X2,N
          IFC    EQ,*N**,1
          SX2    B0
          RJ     WOF
          ENDM
          TITLE  DEAD START LOAD.
 DSL      SPACE  4
**        DSL - DEAD START LOAD.
 
 
          ORG    104B
 DSL      SB1    1           (B1) = 1
          EQ     DSL1
          TITLE  FILE DEFINITIONS.
 FETS     SPACE  4
**        FETS.
 
 
 O        BSS    0
 OUTPUT   FILEC  OBUF,OBUFL,(FET=8)
          ORG    O
          CON    15B
          ORG    O+8
 
 F        BSS    0
 SYSTEM   RFILEB FBUF,FBUFL,(FET=8)
          ORG    F+7
          CON    0LSYSTEM+3
 
 S        BSS    0
 PPULIB   RFILEB SBUF,SBUFL,(FET=9)
          ORG    S+7
          CON    0LSYSTEM
          CON    0LPPULIB
          CON    0LALTSYS
          TITLE  MANAGED TABLES.
 TABLES   SPACE  4
**        MANAGED TABLES ARE USED TO CONTAIN ALL VARIABLE LOAD DATA.
*         THE TABLES ARE CONTROLED BY 2 POINTERS, F.TNAM AND L.TNAM.
*         (F.TNAM) = FWA OF TABLE *TNAM*.
*         (L.TNAM) = LENGTH OF TABLE *TNAM*.
*         THE TABLES ARE MANAGED BY ROUTINE *ATS*.
 
 TLIB     SPACE  4
**        TLIB - LIBRARY AND DIRECTORIES.
*         THE FIRST WORD ADDRESS OF TLIB IS ASSUMED TO BE SBUF.
*         TLIB MUST BE THE FIRST TABLE.
*         TLIB CONTAINS THE RESIDENT LIBRARIES AND DIRECTORIES
*         IN THE SAME FORMAT AND ORDER AS IN LOW CORE.
 
 
 TLIB     TABLE
 TRCD     SPACE  4
**        TRCD - RECORD DIRECTORY.
*         ENTRY = 2 WORDS.
*
*T        42/  NAME,18/  TYPE
*T        30/,30/  RI
*         NAME   RECORD NAME
*         TYPE   RECORD TYPE
*         RI     RANDOM INDEX
 
 
 TRCD     TABLE  2
 TDLT     SPACE  4
**        TDLT - DELETE RECORDS TABLE.
*         ENTRY = 1 WORD.
*
*T        42/  NAME,18/  TYPE
*         NAME   RECORD NAME
*         TYPE   RECORD TYPE
 
 
 TDLT     TABLE
 TFLO     SPACE  4
**        TFLO - FIELD LENGTH OVERRIDE TABLE.
*         ENTRY = 1 WORD.
*
*T        42/  NAME,12/  FL,6/  TYPE
*         NAME   RECORD NAME
*         FL     FIELD LENGTH / 100B
*         TYPE   RECORD TYPE
 
 
 TFLO     TABLE
 TINR     SPACE  4
**        TINR - IGNORE RECORDS TABLE.
*         ENTRY = 1 WORD.
*
*T        42/  NAME,6/  FI,12/  TYPE
*         NAME   RECORD NAME
*         FI     FILE INDEX
*         TYPE   RECORD TYPE
 
 
 TINR     TABLE
 TRES     SPACE  4
**        TRES - RESIDENCY TABLE.
*         ENTRY = 1 WORD.
*
*T        42/  NAME,6/  RC,12/  TYPE
*         NAME   PROGRAM NAME
*         RC     RESIDENCE CODE
*         TYPE   RECORD TYPE
 
 
 TRES     TABLE
 TADR     SPACE  4
**        TADR - ALTERNATE DEVICE RECORDS TABLE.
*         ENTRY = 2 WORDS.
*
*T        6/  DO,12/  TYPE,18/  RDO,24/  RI
*         DO     DEVICE EST ORDINAL
*         TYPE   RECORD TYPE
*         RDO    RECORDS DIRECTORY ORDINAL
*         RI     RANDOM INDEX
*
*         WORD 2 SAME AS WORD 1 UNTIL AFTER SORT
 
 
 TADR     TABLE  2
          SPACE  4,10
**        TEPD - ENTRY POINT DIRECTORY TABLE
*         ENTRY = 1 WORD.
*
*T        42/  NAME,18/  PST
*         NAME   ENTRY POINT NAME
*         PST    PST ORDINAL
 
 TEPD     TABLE
 TSCC     SPACE  4
**        TSCC - TABLE OF SCOPE CONTROL CARDS.
*         ENTRY = 1 WORD.
*
*T        42/  NAME,18/  TYPE
*         NAME   PROGRAM NAME
*         TYPE   RECORD TYPE
 
 
 TSCC     TABLE
 TSYN     SPACE  4
**        TSYN - PROGRAM NAME SYNONYMS.
*         ENTRY = 2 WORDS.
*
 
 
 TSYN     TABLE  2
 TFIL     SPACE  4
**        TFIL - FILE NAMES.
*         ENTRY = 1 WORD.
*
*T        42/  NAME,18/
*         NAME   FILE NAME
 
 
 TFIL     TABLE
 TCMR     SPACE  4,10
**        TCMR - TABLE OF RCL ADDRESSES FOR CM RESIDENT PROGRAMS.
*         ENTRY = 1 WORD.
*
*T        42/0, 18/ RCL
*
*         RCL    ADDRESS OF ENTRY IN CM.
 
 
 TCMR     TABLE
 TSCR     SPACE  4
**        TSCR - SCRATCH TABLE.
 
 
 TSCR     TABLE  2
 TLST     SPACE  4
**        TLST - LIST FOR PROGRAM READS.
*         MUST BE LAST TABLE.
*         ENTRY = 1 WORD.
*
*T        36/,24/  RI
*         RI     RANDOM INDEX
 
 
 TLST     TABLE
 TABLES   SPACE  4
*         REMAINDER OF TABLE MANAGER STORAGE.
 
 
          LIST   G
 TABLES   HERE
          LIST   *
          TITLE  COMMON DATA.
 DATA     SPACE  4
**        *SLL* CONTROL.
 
 
 SL       CON    10000B
 LN       CON    0LLIBD00
 RP       CON    0           FWA OF SYSTEM RPL (SET BY SLL)
 
*         THE ORDER OF THE PREVIOUS WORDS CANNOT BE CHANGED WITHOUT
*         CHANGES TO *SLL*.
 
 
 .ERD     VFD    12/1,18/,18/0,12/ ENTER RESIDENCE DATA
 .CSN     VFD    12/2,18/,18/0,12/ CONVERT SECTOR NUMBERS (SYSTEM FILE)
          VFD    12/2,12/1,6/,18/0,12/ (PPU LIBRARY)
 .WSF     VFD    12/3,18/,18/S,12/ WRITE SYSTEM FILE
 .WPF     VFD    12/4,18/,18/S,12/ WRITE PPU LIBRARY FILE
 .ELD     VFD    12/5,12/,6/,18/SBUF,12/  ENTER LIBRARY DIRECTORY
 .EAD     VFD    12/6,18/L.TLST,18/0,12/ ENTER ALTERNATE DEVICE TABLE
 .WAD     VFD    12/7,18/0,18/S,12/ WRITE ALTERNATE DEVICE
 .RSE     VFD    12/8,18/0,18/EQ,12/0  RETURN SYSTEM EQUIPMENT
 .DPE     VFD    12/9,18/0,18/0,12/0  DROP PP FOR ERROR CONDITION
 
*         COMMON DATA.
 
 T1       CON    0           TEMPORARY STORAGE
 T2       CON    0
 
 EQ       CON    0           SYSTEM DEVICE EST ORDINAL SHIFTED 36
 SC       CON    0           SYSTEM CHANGE FLAG
 DN       VFD    18/0L9D,24/,1/1,17/1 *DSD* TEMPLATE FOR RESIDENT OVLS
 FN       CON    0           FILE NUMBER
 NM       CON    0           RECORD NAME AND TYPE
 TY       CON    0           RECORD TYPE
 SN       CON    1           SECTOR NUMBER
 PE       CON    1           PPU LIBRARY FILE EOI
 EC       CON    0           ERROR COUNT
 ER       CON    PLR         ERROR RETURN
 DL       CON    0           DEAD START LOAD FLAG
 CN       CON    0           COPY NUMBER
 LS       CON    1           LIBDECK STATUS
 AD       CON    0           ALTERNATE LIBRARY FLAG
 CF       CON    0           CHECKPOINT FLAG
 SR       CON    0           SCOPE RECORD COUNT
 NF       CON    0           NUMBER OF FL ENTRIES
 PL       CON    0           NUMBER OF ALTERNATE SYSTEM PLD ENTRIES
 SP       CON    0           *SLL* PRESENT FLAG (FOR ON-LINE *SYSEDIT*)
 
*         LIST DATA.
 
 PN       CON    1           PAGE NUMBER
 LC       CON    99999,0     LINE NUMBER
 LL       EQU    LC+1        LINE LIMIT
 TL       CON    CCDR        ADDRESS OF TITLE TEXT
          SPACE  4
 SSJ=     BSS    0
          VFD    12/0,24/-0,12/SYCS,12/IRSI
          BSSZ   SSJL-1
          TITLE  SYSEDIT - MAIN PROGRAM.
 SYSEDIT  SPACE  4
**        SYSEDIT - MAIN PROGRAM.
 
 
 SYE      RJ     /RDC/RDC    READ DIRECTIVE CARDS
          SA1    EC
          ZR     X1,SYE1     IF NO ERRORS
          SX0    =C*DIRECTIVE ERRORS.*
          EQ     ABT
 
*         ADD CHANGE FILES TO SYSTEM LIBRARY.
 
 SYE1     SA1    SC
          ZR     X1,SYE2     IF NO SYSTEM CHANGES
          SA2    S+7         SET SYSTEM FILE NAME
          SA3    .WSF        SET WRITE SYSTEM REQUEST
          BX6    X2
          MX7    0           CLEAR SECTOR COUNT
          SA6    S
          SA7    S+6
          BX6    X3
          SA6    SL
          RJ     CCF         COPY CHANGE FILES
          RJ     DLR         PROCESS DELETIONS
          RJ     WDR         WRITE DIRECTORY
          SA1    S+6         SET EOF
          PX6    X1
          SA6    A1
          RECALL SL
 
*         GENERATE LIBRARY DIRECTORY.
 
 SYE2     MESSAGE (=C*GENERATING LIBRARY DIRECTORY.*),1
          SA1    LS
          ZR     X1,SYE2.1   IF LIBDECK FOUND
          MESSAGE  SYEC,2    *LIBDECK NOT FOUND - (NAME)*
 SYE2.1   RJ     SLR         SET LIBRARY RESIDENCE
          SA1    F+7         SET SYSTEM FILE NAME
          SA2    S+8         SET PPU LIBRARY FILE NAME
          BX6    X1
          SA3    F+1         SET IN = OUT = FIRST
          LX7    X2
          SA6    F
          SA7    S
          SX6    X3
          SX1    B1          SET RANDOM BIT
          MX0    -48
          LX1    47
          BX3    -X0*X3      CLEAR DEVICE TYPE
          SA6    A3+B1
          BX7    X1+X3
          SA6    A6+B1
          SA7    A3
          RJ     /LIB/LIB    PROCESS LIBRARY TABLES
          SA3    L.TLIB      DECREASE FIELD LENGTH
          SX1    X3+SBUF
          SX6    B1
          LX6    17
          BX1    X1+X6
          MEMORY ,,,X1
          SA3    CF          READ CHECKPOINT FLAG
          SA2    PL          NUMBER OF ALTERNATE SYSTEM PLD ENTRIES
          LX3    12+18
          SA1    .ELD        REQUEST LIBRARY DIRECTORY SETUP
          LX2    36
          IX2    X3+X2
          BX6    X1+X2
          SA6    SL
          RECALL A6
          RJ     CMF         COMPLETE FILES
          SA1    CN          SET CHANGE NUMBER
          RJ     CDD
          SX1    1R.-1R
          SB3    60
          LX1    54
          IX2    X6+X1
          SB4    B3-B2
          LX6    X2,B4
          SA6    SYEB
          MESSAGE SYEA
 SYE3     ENDRUN
 
 SYEA     DATA   30HSYSTEM EDIT COMPLETE - CHANGE
 SYEB     CON    0,0
 SYEC     DATA   C*LIBDECK NOT FOUND - (NAME)*
          TITLE  MAIN PROCESSING ROUTINES.
 CCF      SPACE  4,5
**        CCF - COPY CHANGE FILES.
*         CHANGE FILES ARE COPIED TO SYSTEM FILE.
 
 
 CCF      PS                 ENTRY/EXIT
          SX6    99999       FORCE EJECT
          SX7    =40HSYSTEM FILE CHANGES.
          SA6    LC
          SA7    TL
 CCF1     SA1    L.TFIL      CHECK FILE TABLE
          SA2    FN
          IX6    X1-X2
          SA3    F.TFIL
          SB2    X2
          ZR     X6,CCF      RETURN IF END OF FILES
          SA5    X3+B2       SET FILE NAME
          MX0    42
          BX4    X0*X5
          RECALL F
 .DS1     SA3    X2+B1       SET IN = OUT = FIRST
*         EQ     CCF2        (DISK DEADSTART)
 
          LX5    59          CHECK CONTROL BIT
          SX1    3           SET FILE NAME AND MODE
 
*         SX1    0           (DEADSTART LOAD FROM TAPE)
 
          SX7    X3
          BX6    X4+X1
          SA7    A3+B1
          SA6    X2
          SA7    A7+B1
          NG     X5,CCF2     IF *NO REWIND*
          REWIND X2,R
 CCF2     RJ     CPF         COPY FILE
          SA1    F.TFIL      CHECK FILE CONTROL
          SA2    FN          ADVANCE FILE NUMBER
          IX7    X1+X2
          SX6    X2+B1
          SA3    X7
          SA6    A2
          LX3    59
          NG     X3,CCF1     IF NO REWIND
          REWIND F,R
          EQ     CCF1        LOOP
 CMF      SPACE  4,10
**        CMF - COMPLETE FILES.
 
 
 CMF3     SX6    0           CLEAR OUTPUT FET
          SA6    O
 
 CMF      SUBR               ENTRY/EXIT
          SA3    DL
          SA5    WOF
          NZ     X3,CMF1     IF DEADSTART LOAD
          ZR     X5,CMF3     IF NOTHING LISTED
          PRINT  (=2L  )
          PRINT  (=2L  )
          SA1    =1H         SET SPACES
          SA2    =10HCHANGE
          BX6    X1
          LX7    X2
          SA6    LBUF
          SA7    A6+B1
          SA1    CN
          RJ     CDD
          SX7    0
          SA6    A7+B1
          SA7    A6+B1
          PRINT  LBUF
          WRITER O
          SETFS  X2,0        CLEAR SPECIAL ID STATUS
          EQ     CMFX        RETURN
 
 CMF1     SA3    CMFB
          RETURN O           RETURN DEADSTART LISTING
          SA5    LS          GET LIBDECK STATUS
          SA1    LN          READ LIBDECK NAME
          NZ     X5,CMF2     IF LIBDECK NOT FOUND
          SX3    1R.
 CMF2     MX0    24
          LX1    12
          BX1    X0*X1       ADD LIBDECK NAME TO MESSAGE
          LX3    30
          BX6    X1+X3
          SA6    A3
          MESSAGE CMFA
          EQ     SYE3        EXIT
 
 CMFA     DATA   20HSYSTEM BUILT WITH LI
 CMFB     VFD    60/5L(UNDE+1R
          DATA   C*FINED).*
 DLR      SPACE  4,5
**        DLR - DELETE RECORDS.
 
 
 DLR      PS                 ENTRY/EXIT
 DLR1     SA1    L.TDLT      CHECK DELETE TABLE
          SA2    F.TDLT
          ZR     X1,DLR      RETURN IF END OF TABLE
          SA3    X2
          SX6    X2+B1       DELETE ENTRY
          SX7    X1-1
          SA6    A2
          SA7    A1
          SEARCH TRCD,X3     SEARCH FOR ENTRY
          ZR     X2,DLR1     IF NOT FOUND
          SA1    F.TRCD      SET LWA
          SA4    L.TRCD
          IX1    X1+X4
          BX7    X2          SAVE NAME AND TYPE
          SX3    A2          SET DESTINATION
          SX2    A2+2        SET FWA
          IX1    X1-X2       SET WORD COUNT
          SX6    X4-2        DECREMENT TABLE LENGTH
          SA7    T1
          SA6    A4
          MOVE   X1,X2,X3
 
*         LIST DELETION STATUS.
 
          SA1    =1H         SET SPACES
          SA2    =10HDELETED
          BX6    X2          SET RECORD STATUS
          LX7    X1
          SA5    T1
          SA7    LBUF
          MX0    42
          SA6    A7+B1
          BX1    X0*X5       SPACE FILL NAME
          RJ     SFN
          SA2    TRCN+X5     SET RECORD TYPE
          BX1    X0*X2
          SA6    A6+B1
          RJ     SFN
          BX7    X7-X7       SET END OF BUFFER
          SA6    A6+B1
          SA7    A6+B1
          PRINT  LBUF
          EQ     DLR1        LOOP
 WDR      SPACE  4,5
**        WDR - WRITE DIRECTORY.
 
 
 WDR      PS                 ENTRY/EXIT
          SA2    WDRA+1      ENTER DIRECTORY NAME
          SX6    10B
          ADDWRD TRCD,X2+X6
          SA1    SN          ENTER SECTOR NUMBER
          ADDWRD TRCD,X1
          MX0    14B
          SA1    WDRA        ENTER 7700 TABLE
          SA2    A1+B1
          BX6    X1
          LX7    X2
          SA3    DATE        ENTER DATE
          SA4    A2+B1
          SA6    BUF
          SA7    A6+B1
          BX6    X3
          SA6    A7+B1
          MX6    0
          SA5    L.TRCD      SET DIRECTORY LENGTH
          BX7    X4+X5
 +        SA6    A6+B1       CLEAR REMAINDER OF TABLE
          LX0    1
          NG     X0,*
          SA7    A6+B1
          SX1    60B         CHECK TABLE LENGTH
          IX5    X5-X1
          SX6    100B        SET WORD COUNT
          PL     X5,WDR1     IF FULL FIRST PART
          IX1    X5+X1       SET SHORT LENGTH
          SX6    20B+X5
 WDR1     SA2    F.TRCD      MOVE FIRST PART OF DIRECTORY
          SA6    WC
          IX0    X2+X1       SET NEXT TABLE ADDRESS
          SX3    BUF+20B     ADDRESS TO MOVE TO
          RJ     MVZ         MOVE DATA TO BUFFER
 WDR2     RJ     WTB         WRITE BLOCK
          SA1    WC          CHECK WORD COUNT
          SB2    X1-100B
          NZ     B2,WDR      RETURN IF SHORT BLOCK WRITTEN
          IX5    X5-X1       DECREMENT LENGTH
          SX2    X0          ADDRESS TO MOVE FROM
          SX3    BUF         ADDRESS TO MOVE TO
          RJ     MVZ         MOVE DATA
          SX0    X0+100B     ADVANCE FWA
          PL     X5,WDR2     LOOP IF NOT SHORT BLOCK
          SX6    X5+100B     SET SHORT WORD COUNT
          SA6    WC
          EQ     WDR2
 
 WDRA     VFD    12/7700B,12/16B,36/0
          CON    0LSYSTEM
          VFD    12/7000B,48/0
 MVZ      SPACE  4,20
**        MVZ - MOVE DATA, CHECKING FOR ZERO-LENGTH RECORD ENTRIES.
*
*         THIS ROUTINE MOVES THE DIRECTORY INTO THE WRITE BUFFER,
*         CHECKING FOR ZERO-LENGTH RECORD ENTRIES *(00)*, CHANGING
*         THEM TO THE PROPER RECORD NAME.  THIS MUST BE DONE AT
*         THIS TIME, SINCE THE REST OF *SYSEDIT* REQUIRES THE TABLES
*         TO BE ZERO-WORD TERMINATED, AND A PROPER ZERO-LENGTH RECORD
*         ENTRY WOULD PREMATURELY TERMINATE THE TABLE.
*
*         ENTRY  (X1) = WORD COUNT.
*                (X2) = ADDRESS TO MOVE FROM.
*                (X3) = ADDRESS TO MOVE TO.
*
*         EXIT   ZERO-LENGTH RECORD ENTRIES CONVERTED DURING MOVE.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 2, 3, 4, 6, 7.
*                B - 2, 7.
 
 
 MVZ      SUBR               ENTRY/EXIT
          IX3    X3-X2       DIFFERENCE
          AX1    1           WORD COUNT / 2
          SB2    X3
          SB7    X2          ADDRESS TO MOVE FROM
          ZR     X1,MVZX     IF NO DATA TO MOVE
          SA3    =C*(00)*    ZERO LENGTH RECORD ENTRY
 MVZ1     SA4    B7+B1       MOVE TWO WORDS
          SA2    B7
          LX7    X4
          BX6    X2-X3
          SA7    A4+B2       STORE SECOND WORD
          ZR     X6,MVZ2     IF ZERO LENGTH RECORD ENTRY
          BX6    X2          USE RECORD NAME / TYPE
 MVZ2     SB7    A4+B1       INCREMENT INDEX
          SX1    X1-1
          SA6    A2+B2       STORE FIRST WORD
          NZ     X1,MVZ1     IF NOT COMPLETE
          EQ     MVZX        RETURN
 SLR      SPACE  4,20
**        SLR - SET LIBRARY RESIDENCE.
*
*         *SLR* PERFORMS THE FINAL MODIFICATIONS TO THE MANAGED TABLES
*         BEFORE ACTUALLY GENERATING THE LIBRARY DIRECTORIES.  IT -
*
*         *  CREATES THE ENTRY FOR *1PR* FROM THE ENTRY FOR *PPR*.
*         *  DEFINES *1VN* AND *1VO* AS SYNONYMS FOR *1VP*.
*         *  REQUESTS PROGRAM RESIDENCY INFORMATION FROM *SLL* AND
*                UPDATES *TRES*.
*         *  DETERMINES THE FIRST RECORD OF THE RUNNING SYSTEM.
*
*         USES   X - ALL.
*                A - ALL.
*
*         CALLS  ERT.
*
*         MACROS ADDWRD, RECALL, SEARCH.
 
 
 SLR      SUBR               ENTRY/EXIT
          SA5    SLRA        FIND ENTRY FOR *PPR*
          SEARCH TRCD,X5
          ZR     X2,SLR3     IF NOT FOUND
          SA1    A5+B1       GET NEW ENTRY FIRST WORD
          SA5    A2+B1       GET SECOND WORD
          ADDWRD A0,X1       ADD ENTRY TO END OF TABLE
          ADDWRD A0,X5
 SLR0     SA5    SLRB        FIND ENTRY FOR *9TA*
          SEARCH TRCD,X5
          ZR     X2,SLR3     IF NOT FOUND
          SA5    A2+B1       GET SECOND WORD
          ADDWRD A0,X2       ENSURE *9TA* WILL BE IN THE RUNNING SYSTEM
          ADDWRD A0,X5
 SLR1     ADDWRD TRCD,X6-X6  TERMINATE RECORD TABLE
          ADDWRD TRCD,X6-X6
          SA1    SLRC        CREATE SYNONYMS FOR *1VP*
          SA5    A1+B1
          ADDWRD TSYN,X1
          ADDWRD A0,X5
          SA1    SLRC
          SA5    SLRC+2
          ADDWRD A0,X1
          ADDWRD A0,X5
          SA1    .ERD        ENTER RESIDENCY DATA
          SX2    SBUF
          LX2    12
          BX6    X1+X2
          SA6    SL
          RECALL A6
          SA5    SBUF        FIRST ENTRY
 SLR2     BX1    X5          ENTER RESIDENCY TABLE
          RJ     ERT
          SA5    A5+B1       NEXT ENTRY
          NZ     X5,SLR2     IF NOT END OF LIST
          SA1    SLRD        ESTABLISH START OF RUNNING SYSTEM LIBRARY
          SEARCH TRCD,X1
          ZR     X2,SLR3     IF NOT FOUND
          SA1    F.TRCD      GET FWA OF TRCD
          SX7    A2+B7
          IX2    X7-X1
          SA3    L.TRCD
          SA7    A1
          IX6    X3-X2
          SA4    X7+B1       FIRST RANDOM INDEX
          SA6    A3
 +        BX3    X4          DUPLICATE RANDOM INDEX
          LX4    24
          BX6    X4+X3
          SA4    A4+B7
          SA6    A4-B7
          NZ     X4,*-1
          SA3    .CSN        REQUEST SECTOR COUNT CONVERSION
          LX7    12
          BX6    X3+X7
          SA6    SL
          RECALL A6
          EQ     SLR         RETURN
 
 SLR3     SX0    =10H DIRECTORY
          EQ     SFE
 
 SLRA     CON    0LPPR+PPRT
          CON    0L1PR+PPRT
 SLRB     CON    0L9TA+PPRT
 SLRC     CON    0L1VP+PPRT
          CON    0L1VN+PPRT
          CON    0L1VO+PPRT
 SLRD     CON    0LREC+PPRT
          TITLE  LIBRARY TABLE PROCESSING.
          QUAL   LIB
 LIB      SPACE  4,5
**        LIB - PROCESS LIBRARY TABLES.
 
 
 LIB      PS                 ENTRY/EXIT
          RJ     MSP         PROCESS MS RESIDENT PPU PROGRAMS
          SA1    AD
          ZR     X1,LIB1     IF NO ALTERNATE DEVICE ENTRIES
          SA3    F.TRES
          RJ     ASR         PROCESS ALTERNATE SYSTEM RESIDENT PROGRAMS
 LIB1     SX6    SBUF        RESET LOW MEMORY LIMIT
          SA6    LM
          SA6    F.TLIB
          RJ     CMP         PROCESS CM RESIDENT PPU PROGRAMS
          ADDWRD TLIB,X6-X6  TERMINATE RPL
          RJ     CMC         PROCESS CM RESIDENT CPU PROGRAMS
          ADDWRD TLIB,X6-X6  TERMINATE RCL
          RJ     PLD         GENERATE PLD
          SA3    L.TLIB
          SA2    L.TFLO
          BX7    X3
          SX6    B0
          SA7    T2
          ZR     X2,PFL1     IF NO FL ENTRIES
          SX1    0
          ADDWRD TFLO,X1     TERMINATE FL TABLE
          SX7    X3-1        SET NUMBER OF FL ENTRIES
          SA7    NF
 LIB2     RJ     CLD         GENERATE CLD
          ADDWRD TLIB,X6-X6  TERMINATE CLD
          SA6    L.TADR      CLEAR ALTERNATE DEVICE RECORDS TABLE
          RJ     LBD         GENERATE LBD
          ADDWRD TLIB,X6-X6  TERMINATE LBD
          ADDWRD TLIB,X6-X6  TERMINATE DIRECTORY
          EQ     LIB         RETURN
 CLD      SPACE  4,5
**        CLD - GENERATE CLD.
 
 
 CLD10    SX7    B0          EMPTY TCMR
          SA7    L.TCMR
          ADDWRD TLIB,X6-X6  TERMINATE PST
          SA1    L.TEPD      GET LAST WORD ADDRESS OF EPD
          SA3    F.TEPD      GET FIRST WORD ADDRESS EPD
          SB7    X3
          RJ     SST         SHELL SORT EPD TABLE
          SA5    L.TLIB      GET LENGTH OF TLIB
          SA1    L.TEPD
          ALLOC  TLIB,X1
          IX3    X2+X5       DESTINATION ADDRESS
          BX6    X6-X6
          SA2    F.TEPD      SOURCE ADDRESS
          SA6    L.TEPD
          MOVE   X1,X2,X3
 
 CLD      PS                 ENTRY/EXIT
          SA2    L.TSCC
          ZR     X2,CLD1     IF NO SCOPE RECORDS
          ADDWRD TSCC,X6-X6  TERMINATE TABLE
          SX6    X3-1        SET LENGTH OF TABLE
          SA6    SR
 CLD1     SA1    CLDA        (B3) = START INDEX
          SB2    B1+B1
          SB3    X1
          SA2    F.TRCD
          SX4    CLDE        MASK FOR PERMISSIBLE CLD TYPES
 CLD2     SA3    X2+B3       NEXT ENTRY
          SB7    X3          CHECK TYPE
          AX1    X4,B7
          SB3    B3+B2       ADVANCE INDEX
          LX1    59
          ZR     X3,CLD10    IF END OF DIRECTORY
          CX7    X1
          PL     X1,CLD2     IF WRONG TYPE
          SX6    B3          SAVE (B3)
          SB7    X7          JUMP ON TYPE
          SA6    CLDA
          BX6    X3          SAVE NAME AND TYPE
          SX7    X3          SAVE RECORD TYPE
          SA6    NM
          SA7    TY
          JP     CLDA+B7
 
 CLDA     CON    0
 
 +        SA5    A3+B1
          BX0    X3
          EQ     PRC         PROCESS PROCEDURE RECORD
 
 +        SA5    A3+B1
          MX0    42
          EQ     PPU
 
 +        SA5    A3+1
          EQ     ABS
 
 +        SA5    A3+B1
          MX0    42
          EQ     ULB
 
 +        SA5    A3+B1
          MX0    42
          EQ     OVL
 
 +        SA5    A3+B1
          MX0    42
          EQ     REL
 
 +        SA5    A3+B1
          BX0    X3
          EQ     PRC
 
 CLD3     SX0    =C* CLD.*
          EQ     SFE
 
 CLD4     BSS    0
 CLDB     RJ     PFL         PROCESS FIELD LENGTH
-         EQ     CLDC        IF DONE WITH PFL PROCESSING
 
 CLD5     BSS    0
 CLDC     SA3    SR          GET NUMBER OF SCOPE RECORDS
          SA1    NM
*         EQ     CLD8        WHEN END OF SCOPE RECORDS TABLE
          ZR     X3,CLD7     IF NO SCOPE RECORDS
          SEARCH TSCC,X1
          ZR     X2,CLD8     IF NOT SCOPE RECORD
          SA3    SR
          SA4    PSTA        FETCH PST ENTRY
          SX6    X3-1
          MX7    1
          SA6    A3          DECREMENT COUNT
          LX7    45-59
          BX7    X4+X7
          SA7    PSTA
          NZ     X6,CLD8     IF NOT THRU WITH SCOPE RECORDS
          SA6    L.TSCC      SET TABLE EMPTY
 CLD7     SA3    CLDD
          BX6    X3
          LX6    30          CHANGE TRANSFER
 CLDD     SA6    CLDC
          EQ     CLD8        CONTINUE PROCESSING
 
 CLD8     SA5    SEPA        GET SPECIAL ENTRY POINT WORD
          SA3    PSTA        GET PST ADDRESS
          SA1    TY          GET RECORD TYPE
          BX6    X6-X6
          LX1    36
          ZR     X5,CLD9     IF NO SPECIAL ENTRY POINTS
          SA6    A5
          MX6    1
 CLD9     LX6    44-59       POSITION SPECIAL ENTRY POINT FLAG
          BX3    X3+X6
          ADDWRD TLIB,X3+X1
          ZR     X5,CLD1     IF NO SPECIAL ENTRY POINTS
          MX7    1
          ADDWRD A0,X5+X7
          EQ     CLD1        CONTINUE PROCESSING
 
 
*         PERMISSIBLE CLD RECORD TYPES.
 
 CLDE     EQURT  (TXRT,RLRT,OVRT,ULRT,ABRT,PURT,PRRT)
 
*         LOCATION USED TO ASSEMBLE PST ENTRY.
 
 PSTA     CON    0
 REL      SPACE  4,10
**        REL - PROCESS RELOCATABLE FORMAT.
 
 
 REL      RECALL F
          RJ     INC         INTIALIZE COPY
          NZ     X7,CLD3     IF NO 77 TABLE, ERROR
 REL1     SA3    B6-B1
          LX3    12
          SB4    X3-3600B    CHECK FOR *ENTR* (36) TABLE
          ZR     B4,REL2     IF 36 TABLE
          READW  X2,BUF,B1
          ZR     X1,REL1
          JP     CLD3        ERROR NO 36 TABLE
 
 REL2     LX3    12
          SX0    X3
          READW  F,BUF,1     READ ENTRY POINT NAME
          AX0    1
          SX6    X0
          BX5    -X0
          AX6    6
          ZR     X0,CLD3     IF ILLEGAL ENTRY POINT COUNT
          NZ     X6,CLD3     IF TOO MANY ENTRY POINTS
          RJ     CPR         CHECK PROGRAM RESIDENCE
 
 REL3     SA3    B6-B1       FETCH ENTRY POINT NAME
          MX2    24
          SB3    B0
          SX5    X5+B1       DECREMENT ENTRY COUNT
 REL4     ZR     X6,REL5     IF SPECIAL ENTRY POINT NAME
          SA4    TSEP+B3
          BX4    X2*X4
          SB3    B3+B1
          BX6    X3-X4
          AX6    18
          NZ     X4,REL4     IF NOT END OF SPECIAL ENTRY POINTS
          RJ     AEP         ADD ENTRY POINT
 REL5     ZR     X5,CLD8     IF NO MORE ENTRY POINTS
          READW  F,BUF,2
          ZR     X1,REL3     IF NOT EOR
          JP     CLD3        PROCESS ERROR
 OVL      SPACE  4,10
**        OVL - PROCESS OVERLAY FORMAT.
 
 
 OVL      RJ     CPR         CHECK RESIDENCE
          SA3    NM          GET ENTRY POINT NAME
          RJ     AEP         ADD ENTRY POINT
          EQ     CLD5
 ULB      SPACE  4,10
**        ULB - PROCESS USER LIBRARY FORMAT.
 
 
 ULB      BX3    X0*X3       ENTER NAME AND TAG
          SX2    10000B
          ADDWRD TSCR,X3+X2
          AX5    24
          ADDWRD A0,X5
          EQ     CLD1
 PRC      SPACE  4,10
**        PRC - PROCESS PROCEDURE FORMAT.
 
 
 PRC      RECALL F
          RJ     INC         INITIALIZE COPY
          LX3    42
          SA2    PRCA        CHECK FOR *.PROC,*
          BX6    X3-X2
          SA3    A5-B1       GET ENTRY POINT NAME
          AX6    24
          SA5    A5
          AX5    24
          NZ     X6,CLD1     IF NOT *.PROC*
          SX6    PRRT        SET *PROC* FILE TYPE
          SA6    TY
          MX0    -24
          BX7    -X0*X5
          SA7    PSTA
          RJ     AEP         ADD ENTRY POINT
          EQ     CLD8        CONTINUE PROCESSING
 
 PRCA     CON    6L.PROC,
 ABS      SPACE  4,10
**        ABS - PROCESS ABSOLUTE FORMAT.
 
 
 ABS      RECALL F
          RJ     INC         INITIALIZE COPY
          NZ     X7,CLD3     IF ERROR
          SA3    X2+3        READ *OUT* POINTER
          NZ     B7,ABS1     IF NOT 5400 TABLE
          SX7    7
 ABS1     SB2    X7+B1
          SX6    X3+B2       ADVANCE *OUT* OVER PROGRAM HEADER
          MX0    42
          SA6    A3
          NZ     B4,ABS2     IF NOT SCOPE *ACPM* RECORD
          SX5    B7-B1       SET ENTRY COUNT
 ABS2     ZR     X5,CLD3     IF NO ENTRY POINTS
          BX1    X5
          AX1    6
          NZ     X1,CLD3     IF TOO MANY ENTRY POINTS
          RJ     CPR         CHECK RESIDENCE
          SA1    INCA        SET 5400 TABLE FL
          SA2    PSTA
          BX6    X1+X2
          SB7    B1
          BX5    -X5
          SA6    A2
          READW  F,BUF,B7    READ ENTRY POINT NAME
 ABS3     SA3    B6-B1
          SX5    X5+B1
          RJ     AEP         ADD ENTRY POINT NAME
 ABS4     ZR     X5,CLD4     IF NO MORE ENTRY POINTS
          READW  F,BUF,1     READ ENTRY POINT NAME
          NZ     X1,CLD3     IF EOR
          SA2    B6-B1       (X2) = ENTRY
          SB2    B0
 ABS5     SA1    TSEP+B2
          ZR     X1,ABS3     IF NOT A SPECIAL ENTRY POINT
          MX4    24
          BX3    X2-X1
          SB2    B2+B1
          BX4    X4*X3
          NZ     X4,ABS5     IF NO MATCH
          SB4    X1          (B4) = SHIFT COUNT
          AX1    18
          SB7    X1
          SX5    X5+B1       DECREMENT ENTRY POINT COUNT
          SA1    PSTA
          SA4    SEPA
          SX7    B1
          JP     B7          PROCESS SPECIAL ENTRY POINT
 PPU      SPACE  4,10
**        PPU - PROCESS PERIPHERAL PROCESSOR FORMAT.
 
 
 PPU      RJ     SPR         CHECK PROGRAM RESIDENCE
          RJ     AEP         ADD ENTRY POINT NAME
          EQ     CLD8        CONTINUE PROCESSING
 LBD      SPACE  4,5
**        LBD - GENERATE LDB.
 
 
 LBD      PS                 ENTRY/EXIT
          SA1    L.TSCR      ALLOCATE SPACE
          SA5    L.TLIB
          ALLOC  TLIB,X1
          IX3    X2+X5
          BX6    X6-X6
          SA2    F.TSCR      MOVE TSCR TO TLIB
          SA6    L.TSCR      CLEAR TSCR
          MOVE   X1,X2,X3
          EQ     LBD         RETURN
 CPR      SPACE  4,15
**        CPR - CHECK PROGRAM RESIDENCE.
*
*         ENTRY  (A5) = ADDRESS OF *TRCD* ENTRY.
*
*         EXIT   (X0) = 42 BIT MASK.
*                (X6) = PROGRAM RESIDENCE ON SYSTEM DEVICE.
*                (PSTA) = RESIDENCE OF PROGRAM.
*
*         USES   A - 2, 3, 7.
*                B - NONE.
*                X - 0, 1, 2, 3, 6, 7.
*
*         CALLS  SPR.
 
 
 CPR1     RJ     SPR         SET PROGRAM RESIDENCE
 
 CPR      SUBR               ENTRY/EXIT
          SA3    NM          GET ENTRY POINT NAME
          MX0    42
          SEARCH TADR,X3,X0
          ZR     X2,CPR1     IF NO MATCH FOUND
          MX1    -6
          LX2    -6
          BX7    -X1*X2
          MX6    -24
          SA2    A2+B1
          LX7    24
          BX2    -X6*X2
          MX1    1
          BX7    X7+X2
          LX1    47-59
          SA2    A5
          BX7    X7+X1
          SA7    PSTA
          ADDWRD TLIB,-X6*X2
          EQ     CPRX        RETURN
 SPR      SPACE  4,10
**        SPR - SET PROGRAM RESIDENCE.
*
*         ENTRY  (A5) = ADDRESS OF *TRCD* ENTRY.
*
*         EXIT   (X6) = (PSTA) = PROGRAM RESIDENCE SET.
*
*         USES   A - 1, 2, 6.
*                B - NONE.
*                X - 1, 2, 6, 7.
 
 
 SPR1     MX7    -24
          BX6    -X7*X1
          SA6    PSTA        STORE RESIDENCE
 
 SPR      SUBR               ENTRY/EXIT
          SA1    A5          GET TRCD ENTRY
          SA2    F.TCMR
          MX7    1           SET CM RESIDENT BIT
          BX6    X1
          LX7    46-59
          AX6    48
          IX2    X2+X6
          ZR     X6,SPR1     IF NOT CM RESIDENT
          SA1    X2
          BX6    X1+X7
          SA6    PSTA        SET RESIDENCE
          EQ     SPRX        RETURN
 AEP      SPACE  4,10
**        AEP - ADD ENTRY POINT.
*
*         ENTRY  (X3) = ENTRY POINT NAME.
*
*         USES   A - 1, 2.
*                B - NONE.
*                X - 0, 1, 2, 3.
 
 
 AEP      SUBR               ENTRY/EXIT
          SA1    L.TLIB
          SA2    T2
          MX0    42
          IX2    X1-X2
          BX3    X0*X3
          ADDWRD TEPD,X3+X2
          EQ     AEPX        RETURN
 PFL      SPACE  4,10
**        PFL - PROCESS FIELD LENGTH OVERRIDE.
*
*         ENTRY  (NM) = RECORD NAME TO PROCESS.
*
*         USES   A - 1, 3, 4, 6, 7.
*                B - NONE.
*                X - 0, 1, 2, 3, 4, 6, 7.
*
*         MACROS SEARCH.
 
 
 PFL      EQ     LIB2        ENTRY/EXIT
          BSS    0
          MX0    42+6
          SA1    NM
          LX0    6
          SEARCH TFLO,X1,X0  SEARCH FOR FIELD LENGH OVERRIDE
          ZR     X2,PFL      IF NO CHANGE
          MX7    1
          LX7    43-59
          SA4    PSTA        FETCH PST ENTRY
          MX0    12
          BX4    -X7*X4      CLEAR 5400 TABLE FLAG
          LX2    42
          BX2    X0*X2
          BX4    -X0*X4
          BX7    X2+X4
          SA1    NF          DECREMENT COUNT OF FL ENTRIES
          SX6    X1-1
          SA7    A4          STORE CLD ENTRY
          SA6    A1
 PFL1     NZ     X6,PFL      IF NOT END OF FL PROCESSING
          SA3    CLDB
          BX7    X3
          SA6    L.TFLO      SET TABLE EMPTY
          LX7    30          CHANGE TRANSFER
          SA7    CLDB
          EQ     PFL         RETURN
 TSEP     SPACE  4,25
**        SPECIAL ENTRY POINT DIRECTORY ENTRY.
*
*T SEPA   1/A,1/J,2/0,1/I,1/H,1/B,1/C,1/D,1/E,1/F,1/G,1/K,11/0,18/DA,
*         18/SA
*
*         WHERE-
*         A      SET TO INDICATE SPECIAL ENTRY POINT TABLE ENTRY.
*         B      SET IF ARG= ENTRY POINT PRESENT.
*         C      SET IF DMP= ENTRY POINT PRESENT.
*                (*DA* IS ASSOCIATED PARAMETER.)
*         D      SET IF SDM= ENTRY POINT PRESENT.
*         E      SET IF SSJ= ENTRY POINT PRESENT.
*                (*SA* IS ASSOCIATED ADDRESS.)
*         F      SET IF VAL= ENTRY POINT PRESENT.
*         G      SET IF SSM= ENTRY POINT PRESENT.
*         H      SET IF CLB= ENTRY POINT PRESENT.
*         I      SET IF LDR= ENTRY POINT PRESENT.
*         J      SET IF UTL= ENTRY POINT PRESENT.
*         K      SET IF DPA= ENTRY POINT PRESENT.
*         DA     =  1/R,1/T,1/S,1/C,1/F,1/U,12/FL
*                WHERE, R = RESTART FLAG.
*                       T = SET OVERRIDE REQUIRED STATUS.
*                       S = SUPPRESS DMP= ON CONTROL CARD CALL.
*                       C = ONLY CREATE DM* WITH NOTHING ON IT.
*                       F = DUMP FNT ENTRIES TO FILE DM*.
*                       U = CREATE FILE DM* AS AN UNLOCKED FILE.
*                       FL = 0, FOR DUMP OF FULL FL.
*                          " 0, FOR DUMP OF FL*100B OF FL.
*         SA     SSJ= PARAMETER AREA ADDRESS.
 
 
 SEPA     CON    0           SPECIAL ENTRY POINT WORD
 TSEP     SPACE  4,5
**        TSEP - TABLE OF SPECIAL ENTRY POINTS.
 
 
 TSEP     VFD    24/0LARG=,18/SEP9,18/53  CONTROL STMT CONTROL
          VFD    24/0LDMP=,18/SEP1,18/52  DUMP CONTROL
          VFD    24/0LDPA=,18/SEP9,18/47  *DMP=* ARGUMENT CONTROL
          VFD    24/0LMFL=,18/SEP5,18/48  MINIMUM FL CONTROL
          VFD    24/0LRFL=,18/SEP6,18/48  FIELD LENGTH CONTROL
          VFD    24/0LSDM=,18/SEP9,18/51  SUPPRESS DAYFILE CONTROL
          VFD    24/0LSSJ=,18/SEP2,18/50  SPECIAL SYSTEM JOB CONTROL
          VFD    24/0LVAL=,18/SEP9,18/49  VALIDATION JOB CONTROL
          VFD    24/0LSSM=,18/SEP9,18/48  FL DUMP PROHIBITED
          VFD    24/0LCLB=,18/SEP8,18/54  COMMAND LINE BUFFER FET
          VFD    24/0LLDR=,18/SEP10,18/55 EXECUTE-ONLY READ CONTROL
          VFD    24/0LLIB=,18/SEP9,18/55  EXECUTE-ONLY READ CONTROL
          VFD    24/0LUTL=,18/SEP9,18/56  PF UTILITIES CONTROL
          VFD    24/0LNPC=,18/ABS4,18/0   NOS CRACKING FORMAT FLAG
          CON    0
          SPACE  4,5
**        *ARG=* ENTRY POINT.
*         ARG= ENTRY POINT PREVENTS ARGUMENTS FROM BEING PASSED
*         TO RA + ARGR, AND SUPPRESSES ARGUMENT CHECKING.
 
 
**        *DMP=* ENTRY POINT.
*         DMP= SPECIFIES AMOUNT/100B OF FIELD LENGTH TO DUMP BEFORE
*         LOADING PROGRAM WITH *DMP=* ENTRY POINT.
*         DMP=   = VFD  2/0,1/S,1/C,1/F,1/U,12/FL
*                WHERE, S = SUPPRESS DMP= ON CONTROL CARD CALL.
*                       C = ONLY CREATE DM* WITH NOTHING ON IT.
*                       F = DUMP FNT ENTRIES TO FILE DM*.
*                       U = CREATE FILE DM* AS AN UNLOCKED FILE.
*                       FL = 0, FOR DUMP OF FULL FL.
*                          " 0, FOR DUMP OF FL*100B OF FL.
 
**        *DPA=* ENTRY POINT.
*         *DPA=* SIGNIFIES THAT ARGUMENTS ARE PASSED TO A *DMP=*
*         PROGRAM VIA *ARGR* AND *ACTR*.
 
 
**        *RFL=* ENTRY POINT.
*         RFL= DESIGNATES THE AMOUNT OF FIELD LENGTH REQUIRED TO
*         LOAD THE JOB CONTAINING IT.
 
**        *MFL=* ENTRY POINT.
*         MFL= DESIGNATES THE MINIMUM FIELD LENGTH REQUIRED BY
*         THE JOB.  FIELD LENGTH WILL BE INCREASED TO THIS VALUE
*         IF LESS THAN THIS VALUE.
 
**        *SDM=* ENTRY POINT.
*         SDM= ENTRY POINT CAUSES NO DAYFILE MESSAGE TO BE
*         GENERATED FOR THE CONTROL CARD CALL.
 
**        *SSJ=* ENTRY POINT.
*         SSJ= ENTRY POINT MUST BE PRESENT FOR A JOB TO BE ENTERED
*         AS A SPECIAL SYSTEM JOB.
*         (*RFL=* ENTRY POINT MUST PRECEDE *SSJ=* TO ALLOW
*         ADDRESS VALIDATION IF OTHER THAN ZERO.)
 
**        *VAL=* ENTRY POINT.
*         JOBS CONTAINING VAL= ENTRY POINTS ARE THE ONLY JOBS
*         ALLOWED TO EXECUTE WHEN VALIDATION BITS ARE SET IN THE
*         CONTROL POINT AREA.
 
**        *SSM=* ENTRY POINT.
*         SSM= ENTRY POINT PREVENTS DUMPS OF THE FIELD LENGTH
*                ASSOCIATED WITH THE JOBS CONTROL POINT.
 
**        *CLB=* ENTRY POINT.
*         THE VALUE OF THE CLB= ENTRY POINT SPECIFIES THE ADDRESS
*         OF THE INPUT FET FOR A COMMAND LINE BUFFER.  THE COMMAND
*         LINE WILL BE TRANSFERRED TO THE BUFFER BEFORE THE PROGRAM
*         CONTAINING THE CLB= BEGINS EXECUTION.  THIS IS ONLY
*         VALID FOR TXOT JOBS.
 
**        *LDR=* ENTRY POINT.
*         THE *LDR=* ENTRY POINT ALLOWS THE LOADED PROGRAM
*         TO USE *CIO* CALLS TO READ AN *EXECUTE-ONLY* FILE.
 
**        *LIB=* ENTRY POINT.
*         THE *LIB=* ENTRY POINT IS DEFINED TO ALLOW THE GLOBAL
*         LIBRARY UTILITY EXECUTE-ONLY FILE ACCESS.  THIS ENTRY
*         POINT SHOULD NOT BE USED BY ANY OTHER PROGRAM IF
*         SYSTEM EXECUTE-ONLY FILE SECURITY IS TO BE MAINTAINED.
 
**        *UTL=* ENTRY POINT.
*         ALLOWS JOBS (PRIMARILY INTENDED FOR PF UTILITIES) TO
*         EXECUTE ON AN *OFF* DEVICE, WHEREAS JOBS WILL NORMALLY
*         ROLLOUT WHEN ATTEMPTING TO ACCESS SUCH A DEVICE UNTIL IT
*         HAS BEEN RETURNED TO SERVICE.
 
**        *NPC=* ENTRY POINT.
*         SETS NOS CRACKING FORMAT WHEN PROGRAM IS EXECUTED
*         FROM A USER LIBRARY.  IT IS IGNORED BY *SYSEDIT*.
 
*         PROCESS *DMP=* ENTRY.
 
 SEP1     MX3    -18
          BX2    -X0*X2
          SA1    SEPA
          LX3    18
          MX4    -1
          LX2    18
          BX1    X3*X1
          SX6    B1
          BX1    X2+X1
          EQ     SEP7
 
*         PROCESS *SSJ=* ENTRY.
 
 SEP2     BX6    -X0*X2
          MX3    -17
          AX1    48
          BX2    -X3*X2
          SX4    X2+SSJL     ADD PARAMETER AREA BUFFER
          MX3    -11
          BX1    -X3*X1
          ZR     X2,SEP3     IF NO ADDRESS SPECIFIED
          LX1    6
          IX1    X1-X4
          NG     X1,ABS4     IF ILLEGAL ADDRESS
 SEP3     SA1    SEPA        SET SSJ= ADDRESS IN WORD
          BX1    X0*X1
          BX1    X1+X6
 SEP4     MX4    -1
          SX6    B1
          EQ     SEP7
 
*         PROCESS *MFL=* ENTRY.
 
 SEP5     SX2    X2+400000B
 
*         PROCESS *RFL=* ENTRY.
 
 SEP6     SX6    X2+77B      ROUND FIELD LENGTH
          MX4    -12
          AX6    6
 SEP7     LX4    X4,B4       SHIFT COMPLEMENT MASK
          BX3    X4*X1       CLEAR FIELD
          LX6    X6,B4       SHIFT VALUE
          BX6    -X4*X6      MASK OFF VALUE
          BX6    X3+X6       ADD VALUE TO FIELD
          SA6    A1          ENTER PARAMETER
          ZR     X7,ABS3     IF LDR= ENTRY
          EQ     ABS4        LOOP FOR NEXT ENTRY
 
*         PROCESS *CLB=* ENTRY.
 
 SEP8     MX3    -17
          AX1    48
          BX2    -X3*X2      GET CLB= VALUE
          MX3    -11
          SX4    X2+105B
          BX1    -X3*X1      GET MFL= VALUE
          LX1    6
          IX1    X1-X4
          NG     X1,ABS4     IF ILLEGAL VALUE
 
*         PROCESS *ARG=*, *DPA=*, *SDM=*, *SSM=*, *UTL=* AND *VAL=*
*         ENTRIES.
 
 SEP9     SA1    SEPA
          EQ     SEP4
 
*         PROCESS LDR= ENTRY.
 
 SEP10    SA1    SEPA
          SX5    X5-1        ADJUST ENTRY POINT COUNT
          BX7    X7-X7
          EQ     SEP4        CONTINUE
 ELD      SPACE  4,10
**        ELD - ENTER PERIPHERAL LIBRARY DIRECTORY.
*
*         ENTRY  (X0) = 18 BIT MASK.
*                (X5) = PLD ENTRY.
*
*         USES   A - 3, 6.
*                B - 4, 7.
*                X - 2, 3, 6, 7.
 
 
 ELD      SUBR               ENTRY/EXIT
          ALLOC  TLIB,B1     ALLOCATE SPACE FOR ENTRY
          SB4    X2          SET START OF DIRECTORY
          SB7    B4+X3
          BX2    X0*X5
          SB7    B7-B1       SET END OF DIRECTORY
 ELD1     EQ     B4,B7,ELD2  IF START OF DIRECTORY
          SA3    B7-B1       READ NEXT ENTRY
          BX7    X0*X3
          BX6    X3          MOVE ENTRY DOWN
          IX7    X2-X7
          SA6    A3+B1
          LX7    18
          SB7    B7-B1       DECREMENT PLD ADDRESS
          NG     X7,ELD1     IF NOT AT SLOT FOR NEW ENTRY
          SB7    A6
 ELD2     BX6    X5          INSERT PLD ENTRY
          SA6    B7
          EQ     ELDX        RETURN
 MSP      SPACE  4,5
**        MSP - PROCESS MASS STORAGE RESIDENT PPU PROGRAMS.
*
*         ENTRY  TRCD AND TRES BUILT.
*
*         EXIT   (TSCR) = MS RESIDENT PPU PROGRAMS.
 
 
 MSP      PS                 ENTRY/EXIT
          BX6    X6-X6       CLEAR LIST TABLE
          MX0    54
          SA6    L.TLST
          SA6    L.TSCR      CLEAR SCRATCH TABLE
          LX0    12
          SA0    B0
 MSP0     SA3    F.TRCD
          SB3    A0          (B3) = *TRCD* INDEX
          SB2    B1+B1
          ERRNZ  C.TRCD-2    CODE ASSUMES VALUE
 
*         ENTER PPU PROGRAMS IN LIST FOR COPY.
 
 MSP1     SA5    X3+B3       NEXT ENTRY
          SX6    X5-PLRT     CHECK TYPE
          SB3    B3+B2       ADVANCE INDEX
          SX7    X5-PPRT
          ZR     X5,MSP3     IF END OF DIRECTORY
          ZR     X6,MSP1.1   IF *PPL*
          NZ     X7,MSP1     IF NOT *PP*
 MSP1.1   BX6    X5
          AX6    54
          SB7    X6+1R6&77B
          ZR     B7,MSP1     IF *6*
          EQ     B7,B1,MSP1  IF *7*
          SEARCH TRES,X5,X0  CHECK RESIDENCY
          ZR     X2,MSP2.5   IF NOT FOUND
          SX6    X2-1
          SA3    F.TRCD
          NG     X6,MSP1     IF *CM* RESIDENT
 MSP1.2   SX1    X5-PPRT
          ZR     X1,MSP2     IF *PP*
          SA1    =1H         LIST *IGNORED ... NOT PUT IN PPULIB*
          SA2    =10HIGNORED
          BX6    X2          SET RECORD STATUS
          LX7    X1
          SA7    LBUF
          MX7    42
          SA6    A7+B1
          SA0    B3          SAVE *TRCD* INDEX
          BX1    X7*X5       SPACE FILL NAME
          RJ     SFN
          SA1    TRCN+X5     SET RECORD TYPE
          SA6    A6+1
          RJ     SFN
          SA1    =17LNOT PUT IN PPULIB
          SA2    A1+B1
          SA6    A6+B1
          BX6    X1
          LX7    X2
          SA6    A6+B1
          SA7    A6+B1
          PRINT  LBUF
          EQ     MSP0        CHECK NEXT RECORD
 
 MSP2     SA1    A5+B1       ENTER NAME AND RANDOM ADDRESS
          MX3    24
          BX2    X3*X5
          AX1    24
          LX2    -6
          ADDWRD TLST,X2+X1
          SA3    F.TRCD
          EQ     MSP1
 
 MSP2.5   SA1    DN          CHECK FOR CM RESIDENT *DSD* OVERLAY
          MX2    -18
          BX7    X1-X5
          LX7    12
          BX7    -X2*X7
          ZR     X7,MSP1.2   IF *9DX*
          AX7    2
          NZ     X7,MSP1.2   IF NOT *9EX*, *9FX*, *9GX*
          ADDWRD A0,X1+X5    MAKE OVERLAY CM RESIDENT
          SA3    F.TRCD
          EQ     MSP1        CONTINUE
 
 MSP3     ADDWRD TRES,X6-X6  TERMINATE *TRES*
          SA2    F.TLST      SORT LIST
          SA1    L.TLST
          SB7    X2
          RJ     SST
          ADDWRD TLST,X6-X6  TERMINATE LIST
          SA4    F.TEND      NEW FWA
          IX7    X4-X3
          MX0    24
          SA7    A2
          SA7    F+5         SET LIST ADDRESS
          MOVE   X3,X2,X7    MOVE TABLE UP
          SA1    TN          DECREMENT TABLE COUNT
          SA2    PE          SET SECTOR NUMBER
          SX6    X1-1
          BX7    X2
          SA6    A1
          SA7    SN
 
*         COPY PPU PROGRAMS TO PPU LIBRARY FILE, DELETING 7700
*         TABLE.
 
          READLS F
          SA1    .WPF        ACTIVATE PPU LIBRARY WRITE
          SX6    B0          CLEAR SECTOR COUNT
          BX7    X1
          SA6    S+6
          SA7    SL
 MSP4     READW  F,BUF,1     READ FIRST WORD
          SA2    BUF         CHECK FIRST WORD
          NZ     X1,MSP9     IF EOR
          LX2    18
          SX6    X2-770000B
          LX2    6
          NZ     X6,PLE      IF NO 7700 TABLE
          SX5    X2+1        SKIP 7700 TABLE
 MSP5     READW  F,BUF,1
          SX5    X5-1
          NZ     X5,MSP5
          SA2    L.TSCR      COMPARE PPU CONTROL WORD AND NAME IN LIST
          SA3    F.TLST
          AX2    1
          IX6    X2+X3
          SA1    B6-1
          SA2    X6
          LX2    6
          BX7    X1-X2
          BX3    X0*X7
          ZR     X3,MSP5.1   IF MATCH
          AX2    42
          BX1    X1+X3
          SX2    X2-3R1PR
          NZ     X2,PLE      IF NO MATCH
 MSP5.1   SX2    X1+77B      SET SECTOR COUNT TO BYTE 3 OF PP HEADER
          AX2    6
          SX5    X1
          LX2    12
          BX6    X2+X1
          SA6    A1
          BX1    X1-X5
          ADDWRD TSCR,X1     ENTER PPU CONTROL WORD
          SA1    SN          ENTER SECTOR NUMBER
          SX5    X5-1        SET PROGRAM WORD COUNT
          ADDWRD TSCR,X1
          SX6    77B
          NG     X5,PLE      IF ILLEGAL WORD COUNT
 MSP6     IX5    X5-X6       DECREMENT WORD COUNT
          PL     X5,MSP7     IF NOT SHORT BLOCK
          IX6    X5+X6       SET SHORT COUNT
 MSP7     ZR     X6,MSP8     IF EMPTY BLOCK
          READW  F,B6,X6     READ BLOCK
 MSP8     SX6    B6-BUF      SET WORD COUNT
          SA6    WC
          RJ     WTB         WRITE BLOCK
          SB6    BUF
          SX6    100B
          PL     X5,MSP6     LOOP TO COMPLETE PROGRAM
          EQ     MSP4        PROCESS NEXT PROGRAM
 
*         TERMINATE READ AND REQUEST MASS STORAGE TRANSLATION.
 
 MSP9     ADDWRD TSCR,X6-X6  TERMINATE TSCR
          ADDWRD A0,X1
          SA1    TN          RESET TABLE COUNT
          SA2    S+6         SET EOF
          BX6    X6-X6       CLEAR LIST TABLE
          SX7    X1+B1
          SA6    L.TLST
          PX6    X2
          SA7    A1
          SA6    A2
          RECALL SL          WAIT WRITE COMPLETE
          SA1    F.TSCR      REQUEST SECTOR COUNT CONVERSION
          SA3    .CSN+1
          LX1    12
          BX7    X3+X1
          SA7    SL
          RECALL A7
          EQ     MSP         RETURN
 PLD      SPACE  4,10
**        PLD - GENERATE PLD.
*
*         ENTRY  (TSCR) = MS RESIDENT PPU PROGRAMS.
*                (TADR) = ALTERNATE DEVICE RESIDENT PROGRAMS.
*                (TLIB) = RPL AND RCL ENTRIES.
*
*         EXIT   (TLIB) = RPL, RCL, AND PLD.
 
 
 PLD      PS                 ENTRY/EXIT
          SA1    .RSE        GET SYSTEM EQUIPMENT
          BX6    X1
          SA6    SL
          RECALL A6
          SA1    L.TADR
          MX0    36
          SB3    B0
          SB2    B1+B1
          ZR     X1,PLD2     IF NO ALTERNATE DEVICE ENTRIES
 
*         PROCESS ALTERNATE PLD ENTRIES.
 
          SX6    3
          SA6    CF          SELECT SYSTEM CHECKPOINT
          SB4    59
 PLD1     SA2    F.TADR      READ NEXT ENTRY
          SA1    X2+B3
          SB3    B3+B2
          ZR     X1,PLD2     IF NO MORE ENTRIES
          LX6    X1,B4
          BX1    X0*X1       MASK OUT PROGRAM NAME AND EQUIPMENT
          PL     X6,PLD1     IF CPU PROGRAM
          LX1    -24
          MX4    -12
          BX4    -X4*X1      EXTRACT LA
          AX1    12
          LX1    36
          BX1    X1+X4
          SA4    A1+B1
          BX4    -X0*X4      TRACK AND SECTOR
          LX4    12
          ADDWRD TLIB,X1+X4
          EQ     PLD1
 
*         ALLOCATE PP BREAKPOINT TABLE.
 
 PLD2     R=     A0,TLIB
          MX1    1
          DUP    PBKL,1
          ADDWRD A0,X1
 
*         PROCESS NON-ALTERNATE PLD ENTRIES.
 
          SA3    L.TLIB      SET FWA OF PLD
          SX7    X3+SBUF
          SB5    B0
          SB3    B0
          SA7    T1
          SA7    T2
 PLD3     SA2    F.TSCR
          SA3    X2+B3       READ NEXT ENTRY
          SB3    B3+B2
          ZR     X3,PLD5     IF END OF TSCR
          BX3    X0*X3       EXTRACT NAME AND LOAD ADDRESS
          LX3    -24
          MX1    -12
          BX1    -X1*X3      EXTRACT LA
          BX6    X3-X1
          LX6    24
          BX3    X6+X1
          SA1    EQ
          BX3    X3+X1
          SA1    A3+B1
          BX1    -X0*X1      EXTRACT TRACK AND SECTOR
          LX1    12
          BX1    X1+X3
          LX6    6
          SX6    X6-1R9
          BX5    X1          SAVE ENTRY
          NZ     X6,PLD4     IF NOT *9* LEVEL PROGRAM
          MX0    18
          BX3    X0*X3
          LX3    12
          SB4    X3          FIRST TWO CHARACTERS OF OVERLAY NAME
          SEARCH TADR,X5,X0  CHECK RESIDENCY
          BX1    X5
          MX0    36
          NZ     X2,PLD4     IF ALTERNATE DEVICE RESIDENT
          EQ     B5,B4,PLD3  IF SAME OVERLAY GROUP
          SB5    B4+         SET NEXT DISPLAY OVERLAY GROUP
 PLD4     ADDWRD TLIB,X1     MAKE DIRECTORY ENTRY
          EQ     PLD3        LOOP
 
*         ENABLE ALTERNATE SYSTEM ENTRIES.
 
 PLD5     SA1    T1
          BX7    X7-X7       CLEAR ALTERNATE SYSTEM ENTRIES
          SB3    X1
          SA7    L.TSCR      CLEAR SCRATCH TABLE
          SB2    X1-4
          SX7    PBKL
 PLD6     SA1    B2-B1       READ NEXT ENTRY
          SB2    B2-B1
          ZR     X1,PLD8     IF END OF ALTERNATE DEVICE ENTRIES
          MX0    19
          SB4    B0
          BX6    X1
 PLD7     SA2    B3+B4       READ NEXT ENTRY
          SB4    B4+B1
          BX3    X1-X2
          BX3    X0*X3
          ZR     X2,PLE      IF ENTRY NOT FOUND
          NZ     X3,PLD7     IF NO MATCH
          SA6    A2          SWITCH ENTRIES
          SX7    X7+B1       COUNT ENTRIES
          BX6    X2
          SA6    A1
          EQ     PLD6
 
*         ENTER RPL ENTRIES IN PLD.
 
 PLD8     SA7    PL          SET NUMBER OF ALTERNATE SYSTEM ENTRIES
          SA1    F.TLIB
          SA2    L.TLIB
          SA4    T1          START OF PLD
          IX3    X1+X2
          BX6    X4
          IX7    X3-X4       LENGTH OF PLD
          SA6    A1          RESET TABLE POINTERS
          SA7    A2
          SA5    SBUF        INITIALIZE RPL SEARCH
          MX0    18
          SB5    X5+
          SA1    RP          SET START OF RPL IN LOW CORE
          SB6    X1-SBUF
          SA6    LM          SET LOW MEMORY LIMIT
 PLD9     SX6    X5          PROGRAM LENGTH
          MX7    -36         EXTRACT LOAD ADDRESS
          BX7    -X7*X5
          LX6    12
          SX1    A5+B6       RPL ADDRESS
          AX7    24
          BX2    X0*X5       EXTRACT NAME
          LX1    24
          SX5    B1
          BX6    X6+X7
          LX5    41
          BX1    X1+X5       MERGE *RPL* FLAG
          BX1    X1+X2
          LX2    18
          SX3    X2-3RSFP
          BX5    X1+X6
          NZ     X3,PLD10    IF NOT *SFP*
          BX6    X5
          SA6    T1          SAVE SFP ENTRY
          EQ     PLD12
 
*         ADJUST LOAD ADDRESS AND PROGRAM LENGTH TO NOT LOAD HEADER
*         WORD FOR *6XX* AND *7XX* PROGRAMS.
 
 PLD10    AX2    12
          SB3    X2-1R6
          SX3    B1
          LT     B3,B0,PLD11 IF .LT. *6XX*
          ZR     B3,PLD10.1  IF *6XX* DO NOT INCREMENT CM ADDRESS
          GT     B3,B1,PLD11  IF *8XX* OR *9XX* LOAD HEADER WORD
          LX3    24          INCREMENT CM ADDRESS OF LOAD
          IX5    X5+X3
 PLD10.1  SX3    -10000B+5
          IX5    X5+X3
 
 PLD11    RJ     ELD         ENTER LIBRARY DIRECTORY
 
*         ADVANCE TO NEXT *RPL* ENTRY.
 
 PLD12    SA5    A5+B5       READ NEXT RPL ENTRY
          SB5    X5
          NZ     X5,PLD9     IF NOT END OF RPL
 
*         CHECK AND PROCESS SYNONYMS.
 
 PLD13    SA2    L.TSYN
          SA1    F.TSYN
          ZR     X2,PLD14    IF END OF SYNONYMS
          SX6    X2-C.TSYN   REMOVE ENTRY FROM TABLE
          IX3    X1+X6       SET ADDRESS OF NEXT ENTRY
          SA6    A2
          SA3    X3          READ PRIMARY NAME
          SEARCH TLIB,X3,X0
          ZR     X2,PLD13    IF PRIMARY PROGRAM NOT IN PLD
          SA3    A3+B1
          BX2    -X0*X2      GENERATE ENTRY FOR SYNONYM
          LX6    X3
          BX5    X3+X2
          RJ     MES
          NZ     X2,PLD13    IF SYNONYM NAME EXISTS IN PLD
          RJ     ELD         ENTER SYNONYM IN PLD
          EQ     PLD13       LOOP
 
 PLD14    ALLOC  TLIB,B1+B1  ALLOCATE SPACE FOR *SFP*
          IX3    X2+X3
          SX6    SBUF        RESET POINTERS TO INCLUDE RPL, RCL, PLD
          IX7    X3-X6
          SA6    LM          RESET LOW MEMORY LIMIT
          SA7    A3
          SA6    A2
          SA1    T1          SFP ENTRY IS LAST
          MX4    1
          BX1    -X0*X1
          LX4    42-59
          BX7    X7-X7
          BX6    X1+X4
          SA7    X3-1        SET END OF TABLE
          SA6    A7-B1       *SFP* ENTRY TO LAST PLD SLOT
 
*         SET UP BREAKPOINT INFORMATION.
 
          SA4    T2
          SX6    3L"PBK0"    SET SEARCH FOR *0BK*
          LX6    42
          BX6    X0*X6
          RJ     RRD         REMOVE *0BK* FROM PLD
          BX6    X1
          ZR     X1,PLD16    IF *0BK* NOT FOUND
          LX1    59-41
          NG     X1,PLD16    IF *0BK* CM RESIDENT
          SX6    0
 PLD16    SA6    X4-3        SET *0BK* RESIDENCY STATUS
          SX6    3L"PBK7"
          LX6    42          SET SEARCH FOR *7BK*
          BX6    X0*X6
          RJ     RRD         REMOVE *7BK* FROM PLD
          BX6    X1
          ZR     X1,PLD17    IF *7BK* NOT FOUND
          LX1    59-41
          SA2    X4-3
          PL     X1,PLD17    IF *7BK* NOT CM RESIDENT
          SA6    X4-4
          NZ     X2,PLD      IF *0BK* CM RESIDENT
 PLD17    MX6    1
          SA6    X4-4        DEACTIVATE PP BREAKPOINT TABLE
          SA6    A6+B1
          EQ     PLD         RETURN
 RRD      SPACE  4,15
**        RRD - REMOVE ROUTINE FROM PLD.
*
*         ENTRY  (X0) = 18 BIT MASK.
*                (X4) = FWA OF PLD.
*                (X6) = PACKAGE NAME.
*
*         EXIT   (X1) = 0 IF PACKAGE NOT FOUND.
*                (X1) = PLD ENTRY.
*
*         USES   A - 1, 2, 3, 6.
*                X - 1, 2, 3, 6.
 
 
 RRD      PS                 ENTRY/EXIT
          SA1    X4-1
          SA3    L.TLIB
 RRD1     SA1    A1+B1       GET NEXT PLD ENTRY
          BX2    X0*X1
          ZR     X1,RRD      IF END OF PLD
          IX2    X2-X6
          NZ     X2,RRD1     IF NOT PACKAGE
 
*         DECREMENT COUNT OF ENTRIES IN TLIB.
 
          SX6    B1
          IX6    X3-X6
          SA6    A3
 
*         MOVE REST OF PLD DOWN.
 
          SA2    A1+1        FIRST ENTRY TO MOVE
 RRD2     BX6    X2
          SA6    A2-B1       MOVE ENTRY DOWN
          SA2    A2+1
          NZ     X6,RRD2     IF NOT END OF PLD
          EQ     RRD         RETURN
 CMC      SPACE  4,10
**        CMC - PROCESS CM RESIDENT CPU PROGRAMS.
*
*         ENTRY  TRCD AND TRES BUILT.
*                (TLIB) = RPL ENTRIES.
*
*         EXIT   (TLIB) = RPL AND RCL ENTRIES.
*                (TCMR) = RCL ADDRESSES.
 
 
 CMC      PS                 ENTRY/EXIT
          ADDWRD TCMR,X1-X1  ADD EMPTY ENTRY
 CMC1     SA3    F.TRES      SET TABLE INDEX
          SA1    CMCA
          MX0    54
          SB3    X1+
          LX0    12
 
*         SEARCH FOR CM RESIDENT *OVL*, *ABS* AND *PPU* PROGRAMS.
 
 CMC2     SA5    X3+B3       NEXT RESIDENCY ENTRY
          SX1    X5-400004B
          SB3    B3+B1       ADVANCE INDEX
          SX7    X5-400012B
          SB2    X5-400011B
          ZR     X5,CMC      RETURN IF END OF TABLE
          ZR     X1,CMC3     IF *OVL* AND CM RESIDENT
          ZR     X7,CMC3     IF *PPU* AND CM RESIDENT
          NZ     B2,CMC2     IF NOT *ABS* AND CM RESIDENT
 CMC3     SX7    B3          UPDATE START INDEX
          SA7    CMCA
          SEARCH TRCD,X0*X5  SEARCH FOR RECORD
          ZR     X2,CMC1     IF NOT FOUND
          SA3    L.TCMR      RCL INDEX
          SA1    RP
          LX3    48          POSITION RCL INDEX
          SA5    A2+B1       SET TCMR INDEX
          SA4    L.TLIB
          IX1    X1+X4       COMPUTE RCL ADDRESS
          BX6    X3+X5
          MX4    42
          SA6    A5+         STORE UPDATED TRCD ENTRY
          BX6    X4*X2
          SA6    T1
          ADDWRD TCMR,X1
          SA1    T1
          ADDWRD TLIB,X1     ENTER NAME IN DIRECTORY
 
*         READ PROGRAM TO TLIB.
 
          SX7    X3-1        SAVE INDEX OF ENTRY
          SA7    T1
          RECALL F
          RJ     INC         INITIALIZE COPY
          NZ     X7,CMC8     IF ERROR
          ALLOC  TLIB,100B   ALLOCATE FIRST BLOCK
          IX4    X3-X1
          IX6    X2+X4
          NZ     B4,CMC4     IF NOT SCOPE *ACPM* RECORD
          IX5    X1-X5
          READW  F,X6,B7     READ HEADER AND ENTRY POINTS
          SA3    F+3
          SX6    B6+         ADVANCE *OUT* OVER JUNK
          SX7    X3+2
          BX1    X5          WORD COUNT FOR REMAINDER OF BLOCK
          SA7    A3
 CMC4     READW  F,X6,X1     READ REMAINDER OF BLOCK
          NG     X1,CMC8     IF EOF
          NZ     X1,CMC6     IF END OF RECORD
 CMC5     ALLOC  A0,100B     ALLOCATE FOR NEXT BLOCK
          IX4    X3-X1       SET FWA
          IX6    X2+X4
          READW  F,X6,X1
          ZR     X1,CMC5     LOOP TO EOR
          NG     X1,CMC8     IF EOF
 CMC6     SA2    F.TLIB      READ START OF RESIDENT PROGRAMS
          BX6    X0
          SB2    X2
          NG     X6,CMC7     IF NOT *ACPM* RECORD
          SX1    X1+B1
          SA6    B6          APPEND *ENDS* WORD
 CMC7     SA4    T1
          IX6    X1-X2       SET LENGTH TO NEXT PROGRAM
          SA3    B2+X4
          IX0    X6-X4
          BX7    X3+X0       ADD LENGTH TO CONTROL WORD
          SA6    L.TLIB
          SA7    A3
          EQ     CMC1        LOOP
 
 CMC8     SX0    =C* RCL.*
          EQ     SFE
 
 CMCA     CON    0
 CMP      SPACE  4,5
**        CMP - PROCESS CM RESIDENT PPU PROGRAMS.
*
*         ENTRY  TRCD AND TRES BUILT.
*
*         EXIT   (TLIB) = RPL ENTRIES.
 
 
 CMP      PS                 ENTRY/EXIT
          SA3    F.TRES
          SB3    B0          (B3) = START INDEX
          BX6    X6-X6       CLEAR LIST TABLE
          MX0    54
          SA6    L.TLST
          LX0    12
 
*         ENTER PPU PROGRAMS IN LIST FOR READ.
 
 CMP1     SA5    X3+B3       NEXT RESIDENCY ENTRY
          SX6    X5-400000B-PLRT  CHECK FOR *PPL* TYPE
          SB3    B3+B1       ADVANCE INDEX
          SX7    X5-400000B-PPRT  CHECK FOR *PP* TYPE
          ZR     X5,CMP2     IF END OF TABLE
          ZR     X6,CMP1.1   IF *PPL* AND CM RESIDENT
          NZ     X7,CMP1     IF NOT *PP* AND CM RESIDENT
 CMP1.1   SEARCH TRCD,X0*X5  SEARCH FOR RECORD
          SA3    F.TRES
          ZR     X2,CMP1     IF NOT FOUND
          SA1    A2+B1       ENTER NAME AND RANDOM ADDRESS
          MX3    24
          BX6    X3*X2
          AX1    24
          ADDWRD TLST,X6+X1
          SA3    F.TRES
          EQ     CMP1
 
 CMP2     SA1    L.TLST
          ZR     X1,RPE
          RECALL F
          SA1    X2+B1       SET IN = OUT = FIRST
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
          ADDWRD TLST,X6-X6  TERMINATE TABLE
          SA4    F.TEND      NEW FWA
          IX7    X4-X3
          SA7    A2
          SA6    T1          CLEAR PROGRAM COUNT
          SA7    F+5         SET LIST ADDRESS
          MOVE   X3,X2,X7    MOVE TABLE UP
          SA1    TN          DECREMENT TABLE COUNT
          SX6    X1-1
          SA6    A1
 
*         READ PPU PROGRAMS TO *TRSL*.
 
          READLS F
 CMP3     READW  F,BUF,1     READ FIRST WORD
          SA2    BUF         CHECK FIRST WORD
          NZ     X1,CMP7     IF EOR
          LX2    18
          SX6    X2-770000B
          LX2    6
          NZ     X6,RPE      IF NO 7700 TABLE
          READW  F,BUF+1,X2  SKIP 7700 TABLE
          READW  X2,BUF,B1   READ PP HEADER WORD
          SA1    BUF
          MX0    24          SET PP NAME MASK
          AX1    48
          SX1    X1-776100B
          NZ     X1,CMP4     IF NOT *PPL* RECORD
          MX0    18          SET PP NAME MASK
          RJ     BPH         BUILD PPL HEADER
 CMP4     SA2    T1          COMPARE PPU CONTROL WORD AND NAME IN LIST
          SA3    F.TLST
          IX6    X2+X3
          SA1    BUF
          SA3    X6
          BX4    X1-X3
          SX5    X1-1        SET PROGRAM WORD COUNT
          SX7    X2+B1       ADVANCE COUNT
          BX3    X0*X4
          SA7    A2
          NZ     X3,RPE      IF NO MATCH
          ADDWRD TLIB,X1     ENTER PPU CONTROL WORD
          SX6    77B
          NG     X5,RPE      IF ILLEGAL WORD COUNT
 CMP5     IX5    X5-X6       DECREMENT WORD COUNT
          PL     X5,CMP6     IF NOT SHORT BLOCK
          IX6    X5+X6       SET SHORT COUNT
 CMP6     ZR     X6,CMP3     IF EMPTY BLOCK
          ALLOC  TLIB,X6     ALLOCATE FOR BLOCK
          IX4    X3-X1       SET FWA
          IX6    X2+X4
          READW  F,X6,X1
          PL     X5,CMP5     LOOP TO COMPLETE PROGRAM
          EQ     CMP3        LOOP TO NEXT PROGRAM
 
 CMP7     SA1    TN          RESET TABLE COUNT
          SX6    X1+B1
          SA6    A1
          EQ     CMP         RETURN
 ASR      SPACE  4,10
**        ASR - PROCESS ALTERNATE LIBRARIES.
*
*         ENTRY  TRCD AND TRES BUILT.
*                (TSCR) = MS RESIDENT PPU PROGRAMS.
*
*         EXIT   (TADR) = ALTERNATE DEVICE PPU PROGRAMS.
 
 
 ASR      PS     0           ENTRY/EXIT
          MX0    54
          SB3    0           INITIALIZE INDEX
          LX0    12
 ASR1     SA1    X3+B3       READ RESIDENCY TABLE
          BX7    -X0*X1
          ZR     X1,ASR3     IF END OF TABLE
          SB3    B3+B1
          ZR     X7,ASR1     IF NOT ALTERNATE DEVICE ENTRY
          SX4    X7
          NG     X4,ASR1     IF CM RESIDENT
          BX5    X1
          SEARCH TRCD,X5,X0
          ZR     X2,ASR2     IF RECORD NOT FOUND
          SX4    X5
          SA1    X7+B1       GET RANDOM ADDRESS
          LX4    18
          SA3    F.TRCD
          IX7    X7-X3       SET TRCD INDEX
          AX1    24
          BX3    X4+X7       MERGE DEVICE ORDINAL AND TYPE
          LX3    24
          ADDWRD TADR,X3+X1
          ADDWRD A0,X1       DUP ENTRY FOR SORT
 ASR2     SA3    F.TRES
          EQ     ASR1
 
 ASR3     ADDWRD TADR,X1
          SB6    X3          SAVE TABLE LENGTH
          ADDWRD A0,X1       TERMINATE TABLE
          SX1    B6-B1
          SB7    X2
          RJ     SST         SORT TADR ON DEVICE AND TYPE
          SA5    B7
          SA3    F.TRCD
          SB3    -B1
          ZR     X5,ASR      IF EMPTY TABLE
          MX0    18
          SB6    X3
 ASR4     LX5    6
          MX2    11
          BX4    X2*X5
          ERRNZ  PPRT-1
          LX5    12+18
          NZ     X4,ASR5     IF TYPE OVL OR ABS
          SA3    X5+B6
          BX6    X3
          LX5    42
          SEARCH TSCR,X6,X0  FIND ENTRY FOR LOAD ADDRESS
          SX3    X5+B3
          ZR     X2,WAD8     IF RECORD NOT FOUND
          LX3    24
          BX7    -X0*X5
          LX7    42
          BX4    X2+X3       ADD DEVICE ORDINAL
          AX3    24+6
          SA7    A5+B1
          SX3    X3+B1
          ERRNZ  PPRT-1
          BX6    X4+X3       ADD TYPE = *PP*
          SA6    A7-B1
 ASR5     SA5    A5+2
          NZ     X5,ASR4     IF NOT END OF TABLE
 
*         WRITE ALTERNATE DEVICE.
 
          SA1    F.TADR
          SA5    X1
          BX6    X5
          SA6    T2
          SA1    T2
 WAD1     MX0    6
          SA3    A5+B1
          BX4    X0*X3       SET NEXT DEVICE
          LX7    X1
 WAD2     SA3    A3+2
          BX6    X0*X3
          IX2    X4-X6
          ZR     X2,WAD2     IF SAME DEVICE
          SA2    A3-B1
          SA7    A5          RESTORE TABLE ENTRY
          BX6    X2
          SX4    A5
          SA6    T2          SAVE LIST ENTRY
          SA3    S+9
          SX7    0
          BX6    X3
          SA7    A2          CLEAR TABLE ENTRY
          SA1    .WAD
          SA6    S           SET FILE NAME IN FET
          LX4    12+18
          BX6    X1+X4
          SA7    S+6         CLEAR SECTOR COUNT
          SA6    SL          START *SLL*
 WAD3     SA3    A5+B1
          BX5    X3
          SA1    F+1
          AX3    24
          SX7    X7+B1
          SB4    X3
          SA7    A3
          ZR     B4,WAD4     IF PP ENTRY
          SA2    F.TRCD
          MX0    42
          SA4    X2+B4
          AX3    18+12
          BX4    X0*X4
          LX3    6
          BX7    X4+X3
          SA7    A5+
 WAD4     SX2    A1-B1       SET FET ADDRESS
          LX5    24
          RJ     INC         INITIALIZE COPY
          NZ     X7,CLD3     IF ERROR
          NZ     B4,WAD4.1   IF NO SCOPE *ACPM* RECORD
          READW  X2,BUF,B7   READ HEADER AND ENTRY POINTS
          SA3    X2+3
          SX6    X3+2        ADVANCE OUT OVER JUNK
          BX5    -X5
          SA6    A3
          SB7    X5+BUFL     WORD COUNT FOR REMAINDER OF BLOCK
          EQ     WAD6
 
 WAD4.1   SA1    F+3         READ *OUT*
          SA1    X1          CHECK FOR PP HEADER
          BX2    X1
          LX2    6
          AX2    54
          ZR     X2,WAD5     IF NOT PP PROGRAM
          SX6    X1+77B      SET SECTOR COUNT
          AX6    6
          LX6    12
          BX6    X6+X1
          SA6    A1          STORE PP HEADER WITH SECTOR COUNT
 WAD5     SB6    BUF
          SB7    BUFL        SET BLOCK LENGTH
 WAD6     READW  F,B6,B7
          ZR     X1,WAD7     IF FULL BLOCK READ
          NG     X0,WAD7     IF NOT *ACPM* RECORD
          SB6    B6+B1
          BX6    X0          APPEND *ENDS* WORD
          SB3    BUF+BUFL
          SA6    B6-1
          NE     B6,B3,WAD7  IF NOT FULL SECTOR
          SX6    BUFL
          SA6    WC
          WRITEW S,A6,X6+B1  WRITE FULL SECTOR
          SA4    S+6
          SB6    BUF
          SX7    X4+1        UPDATE SECTOR COUNT
          SX1    B1
          SA7    A4
 WAD7     SX6    B6-BUF
          SA6    WC          SET WORD COUNT
          BX5    X1
          WRITEW S,A6,X6+1
          SA4    S+6
          SX7    X4+B1       UPDATE SECTOR COUNT
          SA7    A4
          ZR     X5,WAD5     IF NOT EOR
          SA5    A5+2
          NZ     X5,WAD3     IF NOT DONE WITH DEVICE
          PX6    X7
          SA6    A4
          RECALL SL          WAIT WRITE COMPLETE
          SA1    T2
          NZ     X1,WAD1     IF NOT LAST ALTERNATE DEVICE
          EQ     ASR         RETURN
 
 WAD8     SX0    =C*RECORD NOT FOUND.*
          EQ     ABT
 INC      SPACE  4,15
**        INC - INITIALIZE COPY.
*
*         ENTRY  X2 = FET ADDRESS.
*                X5 = RANDOM INDEX (BITS 24 - 47).
*
*         EXIT   X7 " 0 IF ERROR.
*                B4 = 0 IF SCOPE *ACPM* RECORD.
*                B7 = 0 IF 5400 TABLE.
*                *OUT* POINTER ADVANCED OVER 7700 TABLE.
*                X3 = FIRST WORD OF PROCEDURE RECORD IF FROM *PRC*.
*
*         USES   A - 1, 3, 4, 6, 7.
*                B - 2, 4, 7.
*                X - 0, 1, 3, 4, 5, 6, 7.
 
 
 INC      PS     0           ENTRY/EXIT
          BX6    X6-X6       CLEAR 5400 TABLE FL SPECIFICATION
          MX0    -24
          SA6    INCA
          SA4    X2+B1
          AX5    24
          SX7    X4          SET IN = OUT = FIRST
          BX6    -X0*X5
          SA7    A4+B1
          SA6    X2+6        STORE RANDOM INDEX
          NO
          SA7    A7+B1
          READ   X2
          SX5    X4
          READW  X2,BUF,B1
          SA3    B6-B1
          LX3    18          CHECK FOR 7700 TABLE
          SX7    X3-770000B
          NZ     X7,INC      IF NO 7700 TABLE
          LX3    6
          SX4    X3+B1
          IX6    X4+X5       SET *OUT* TO BYPASS 7700 TABLE
          SA6    X2+3
          MX0    18
          SA1    X6
          BX3    X0*X1       CHECK FOR SCOPE *ACPM* TABLE
          SX5    X1
          LX3    12
          SB4    X3-5300B
          NZ     B4,INC2     IF NOT *ACPM* TABLE
          BX5    -X5
          PL     X5,INC1     IF MULTIPLE ENTRY POINTS
          SX5    B0
 INC1     LX0    18
          SB7    X5+B1
          BX1    X0*X1
          SA4    A1+B7       CHECK *WCL* FIELD
          LX0    18
          SA3    A4+B1       READ *ENDS* WORD
          SX5    B7
          BX3    X0*X3
          SX7    X4
          BX0    X3+X1       SAVE *ENDS* WORD
          EQ     INC
 
 INC2     SB7    X3-5400B
          SA4    A1+4        READ *DEFL* AND *HHA*
          NZ     B7,INC      IF NOT 5400 TABLE
          LX4    59-17       CHECK FOR *DEFL*
          MX6    1
          SX1    X4
          LX6    43-59       SET 5400 TABLE FLAG
          SA6    INCA
          NZ     X1,INC3     IF *DEFL* SPECIFIED
          LX4    59-41       CHECK FOR *HHA*
          SX1    X4
          ZR     X1,INC      IF *DEFL* AND *HHA* NOT SPECIFIED, RETURN
          MX4    2           SET MFL= CONTROL
          BX6    X4+X6
 INC3     SX4    X1+77B      ROUND UP BY 100B
          MX0    12
          LX4    59-17
          BX4    X0*X4
          BX6    X6+X4       SET 5400 TABLE FIELD LENGTH
          SA6    INCA
          EQ     INC         RETURN
 
 INCA     CON    0           5400 TABLE FIELD LENGTH SPECIFICATION
          TITLE  FILE COPY ROUTINES.
          QUAL
 CPF      SPACE  4,5
**        CPF - COPY FILE.
*         COPY FILE *F* TO FILE *S*.
 
 
 CPF      PS                 ENTRY/EXIT
          SX6    0           CLEAR WORD COUNT
          SA6    WC
          SA1    DL
          NZ     X1,CPF1     IF DEADSTART LOAD
          READCW F,17B
 CPF1     RJ     RDB         READ BLOCK
          NG     X1,CPF      RETURN IF EOF
          ZR     X6,CPF7     IF ZERO RECORD
          SA5    BUF         SET FIRST WORD
          SX2    A5
          IX1    X2+X6       SET RECORD TYPE
          RJ     SRT
          ZR     X6,CPF6     IF NULL RECORD
          SX3    X6-ODRT     CHECK TYPE
          ZR     X3,CPF8     IF *OPLD*
          SA6    TY          SET NAME AND TYPE
          SA7    CPFA+1      SET NAME IN MESSAGE
          SA2    FN          SEARCH IGNORE TABLE
          LX2    12
          SEARCH TINR,X6+X2
          NZ     X2,CPF5     IF FOUND
          MESSAGE CPFA,1
          RJ     CRS         CHECK RECORD STATUS
          SA1    TY          CHECK TYPE
          SX6    X1-ULRT
          SA2    LN
          ZR     X6,CPF3     IF *ULIB*
          BX6    X1-X2
          ZR     X6,SLS      IF *LIBDECK*/*TEXT*
 
*         COPY RECORD.
 
 CPF2     RJ     WTB         WRITE BLOCK
          SA1    WC
          SX6    X1-100B
          NG     X6,CPF1     IF EOR
          RJ     RDB         READ BLOCK
          EQ     CPF2        LOOP
 
*         COPY *ULIB*.
 
 CPF3     RJ     WTB         WRITE BLOCK
          SA1    WC          CHECK WORD COUNT
          SX6    X1-100B
          NG     X6,CPF4     IF SHORT BLOCK
          RJ     RDB         READ BLOCK
          EQ     CPF3        LOOP
 
 CPF4     SA1    TY          CHECK TYPE
          SX6    X1-ODRT
          ZR     X6,CPF1     IF OPLD
          RJ     RDB         READ BLOCK
          NG     X1,CPF      RETURN IF EOF
          SX2    BUF         SET RECORD TYPE
          IX1    X2+X6
          RJ     SRT
          SA6    TY
          EQ     CPF3
 
*         PROCESS IGNORED RECORD.
 
 CPF5     SA1    CPFA+1      SET SKIPPING MESSAGE
          BX6    X1
          SA6    CPFB+1
          MESSAGE A6-B1,1
          SA1    TY
          SX6    X1-ULRT
          SA6    CPFC
 CPF6     SA1    WC          CHECK WORD COUNT
          SX6    X1-100B
          NG     X6,CPF6.1   IF EOR REACHED
          RJ     RDB         READ BLOCK
          EQ     CPF6        LOOP
 
 CPF6.1   SA1    CPFC
          NZ     X1,CPF1     IF NOT IGNORING A *ULIB* RECORD
          SA1    TY          CHECK RECORD TYPE
          SX6    X1-ODRT
          ZR     X6,CPF1     IF DIRECTORY FOUND
          RJ     RDB         READ BLOCK
          NG     X1,CPF      IF EOF REACHED
          SX2    BUF
          IX1    X2+X6
          RJ     SRT         SET RECORD TYPE
          SA6    TY
          EQ     CPF6        PROCESS NEXT RECORD
 
*         PROCESS ZERO RECORD.
 
 CPF7     SA1    =4L(00)
          ADDWRD TRCD,X1
          SA1    SN
          ADDWRD TRCD,X1
          RJ     WTB         WRITE BLOCK
          EQ     CPF1
 
*         PROCESS *OPLD*.
 
 CPF8     SA1    WC          CHECK WORD COUNT
          SX6    X1-100B
          NG     X6,CPF1     IF EOR
          RJ     RDB         READ BLOCK
          PL     X1,CPF8     IF NOT EOF
          EQ     CPF         RETURN ON EOF
 
 CPFA     CON    10H COPYING
          CON    0,0
 
 CPFB     CON    10HSKIPPING
          CON    0,0
 CPFC     CON    0           *ULIB* BEING IGNORED FLAG
 CRS      SPACE  4,5
**        CRS - CHECK RECORD STATUS.
 
 
 CRS      PS                 ENTRY/EXIT
          SA1    TY          SEARCH FOR RECORD
          SEARCH TRCD,X1
          ZR     X2,CRS1     IF NOT FOUND
          SA1    SN          REPLACE RECORD
          BX7    X1
          SA6    A2
          SA7    A2+1
          SA3    =10HREPLACED
          EQ     CRS2
 
 CRS1     ADDWRD TRCD,X6     ADD RECORD
          SA1    SN
          ADDWRD A0,X1
          SA3    =10HADDED
 
 CRS2     SA1    =1H         SET SPACES
          BX6    X3          SET RECORD STATUS
          LX7    X1
          SA5    TY
          SA7    LBUF
          MX0    42
          SA6    A7+B1
          BX1    X0*X5       SPACE FILL NAME
          RJ     SFN
          SA2    TRCN+X5     SET RECORD TYPE
          BX1    X0*X2
          SA6    A6+B1
          RJ     SFN
          SA6    A6+1
 
*         COPY 7700 TABLE.
 
          SA1    BUF
          RJ     CPT
          PRINT  LBUF
          EQ     CRS         RETURN
 RCW      SPACE  4,15
**        RCW - READ CONTROL WORD.
*
*         EXIT   (X5) = WORD COUNT OF DATA FOLLOWING CONTROL WORD.
*                (A5) = *RDBA*.
*                TO *RDBX* IF EOF.
*
*         USES   A - 1, 5, 6, 7.
*                B - 7.
*                X - 1, 3, 5, 6, 7.
*
*         MACROS READW.
 
 
 RCW2     SA5    B6-B1       GET CONTROL WORD
          SB7    4
          SX3    B7+B1
          SX7    X5+B7
          IX6    X7/X3       SET WORD COUNT
          SA6    A5
          AX5    36
          SX2    X5          PRU SIZE
          IX7    X2-X6       EOR IF NONZERO
          BX5    X6
          SA7    A6+B1       SAVE EOR FLAG
 
 RCW      SUBR               ENTRY/EXIT
          SA1    RCWA
          SX6    B1          CLEAR FIRST CALL FLAG
          SA6    A1
          ZR     X1,RCW1     IF FIRST CALL
          SB7    1
          READW  F,RDBA,B7   SKIP TRAILER CONTROL WORD
 RCW1     SB7    1           READ HEADER CONTROL WORD
          READW  F,RDBA,B7
          PL     X1,RCW2     IF NOT EOF
          SX6    B0+
          SA6    RCWA        SET FIRST CALL FLAG FOR NEXT FILE
          SA6    RDBA        REINITIALIZE *RDB*
          SA6    A6+B1
          EQ     RDBX        EXIT
 
 
 RCWA     CON    0           FIRST CALL FLAG
 RDB      SPACE  4,15
**        RDB - READ BLOCK.
*
*         EXIT   (X6) = (WC) = BLOCK WORD COUNT.
*                (X1) .LT. 0 IF EOF.
*
*         USES   A - 1, 2, 5, 6, 7.
*                X - 1, 2, 5, 6, 7.
*
*         CALLS  RCW.
*
*         MACROS READW.
 
 
 RDB6     SA2    A5+B1       CHECK BLOCK CONTROL WORD
          ZR     X2,RDB3     IF NOT EOR
          BX6    X6-X6
          SA6    A2+         CLEAR EOR FLAG FOR NEXT CALL
          SA6    WC
 
 RDB      SUBR               ENTRY/EXIT
          SA5    RDBA        WORDS LEFT IN PRU
          EQ     RDB4        CONTINUE
 
 RDB3     RJ     RCW         READ CONTROL WORD
 RDB4     ZR     X5,RDB6     IF NO WORDS LEFT IN PRU
          SX6    100B        NORMAL BLOCK SIZE
          IX7    X5-X6
          SA7    A5
          SA6    WC          SET DATA WORD COUNT
          PL     X7,RDB5     IF AT LEAST 100B WORDS IN PRU
          IX6    X7+X6
          SA6    A6          RETURN WORDS REMAINING IN PRU
          BX7    X7-X7
          SA7    A5+         SET NO WORDS LEFT IN PRU
          SA7    A5+B1       CLEAR EOR FLAG FOR NEXT CALL
 RDB5     READW  F,BUF,X6    READ DATA
          SA1    WC          RETURN WORD COUNT
          BX6    X1
          EQ     RDBX        RETURN
 
 
 RDBA     CON    0           WORDS LEFT IN PRU
 RDBB     CON    0           EOR FLAG
 SLS      SPACE  4,5
**        SLS - SET LIBRARY STATUS.
 
 
 SLS      SX7    C.TRES      CLEAR RESIDENCY TABLE
          BX6    X6-X6
          SB2    B1          SET FIRST WORD
          SA7    L.TRES
          SB4    -1
          SA6    L.TSCC      CLEAR LIST OF SCOPE CONTROL CARDS
          SX7    ERS1
          SA6    L.TFLO      CLEAR FIELD LENGTH OVERRIDE TABLE
          SA7    ER          SET ERROR RETURN
          SA6    L.TSYN      CLEAR TABLE OF PPU SYNONYMS
          SA6    LS          SET LIBDECK STATUS (FOUND)
          SA6    AD          CLEAR ALTERNATE DEVICE STATUS
 SLS1     SA1    BUF+B2
          SA2    WC
          MX3    1
          SB3    X2
          MX4    -6
          SA5    A1          SAVE DIRECTIVE ADDRESS
 SLS2     LX1    6           UNPACK WORD
          BX6    -X4*X1
          SB4    B4+B1
          LX3    6
          SA6    LBUF+B4
          PL     X3,SLS2
          SB2    B2+B1       ADVANCE WORD COUNT
          SA1    A1+B1       NEXT WORD
          ZR     X6,SLS4     IF END OF DATA
          LT     B2,B3,SLS2  IF NOT END OF BUFFER
 SLS3     SX7    B4          SAVE STRING BUFFER POSITION
          SA7    T2
          RJ     WTB         WRITE BUFFER
          SA1    WC          CHECK WORD COUNT
          SX6    X1-100B
          NZ     X6,CPF1     IF EOR
          RJ     RDB         READ BLOCK
          SA1    T2          RESTORE STRING BUFFER POSITION
          SB2    B0
          SB4    X1
          EQ     SLS1
 
 SLS4     SX6    B2          SAVE (B2)
          SA6    T1
          RJ     ERS         ENTER RESIDENCY STATUS
          SA1    T1          RESTORE (B2)
          SB2    X1
          SB4    -B1
          SA2    WC
          SB3    X2
          LT     B2,B3,SLS1  IF NOT END OF BUFFER
          EQ     SLS3
          TITLE  RESIDENCY PROCESSING.
 ERS      SPACE  4,5
**        ERS - ENTER RESIDENCY STATUS.
*
*         ENTRY  (LBUF) = DIRECTIVE.
 
 
 ERS1     SX0    200         SET RECALL CYCLE TIME
          MESSAGE ERSA       DISPLAY ERROR MESSAGE
          MESSAGE A5         DISPLAY DIRECTIVE IN ERROR
          MESSAGE ERSA,2
 ERS2     RECALL             PAUSE
          SX0    X0-1
          NZ     X0,ERS2     WAIT 5 SECONDS
 
 ERS      PS                 ENTRY/EXIT
          SB7    ERS         SET COMMENT PROCESSOR ADDRESS
          KEYWD  CM,RES
          KEYWD  AD,RES4
          KEYWD  FL,FLO
          KEYWD  PPSYN,PPS
          KEYWD  PROC,ERS    *PROC ACCEPTED BUT NO LONGER REQUIRED
          KEYWD  MS,RES1
          KEYWD  SC,SCC
          EQ     ERS         RETURN
 
 ERSA     DATA   10H ERROR IN
          CON    0
 FLO      SPACE  4,5
**        FLO - SET FIELD LENGTH OVERRIDE FOR SPECIFIED RECORDS.
 
 
 FLO1     ADDWRD A0,X5+X6    ADD ENTRY TO TABLE
 FLO2     SA2    B6
          SA1    B6+B1       ADVANCE CHARACTER ADDRESS
          SB2    X2-1R       CHECK SEPARATOR
          ZR     B2,ERS      IF END OF DIRECTIVE
          NE     B2,B1,ERS   IF SEPARATOR NOT *,*
 FLO      RJ     ARN         ASSEMBLE RECORD NAME
          SB2    X1-1R-      CHECK SEPARATOR
          SA6    FLOA        SAVE RECORD NAME + TYPE
          NZ     B2,ERS      IF ILLEGAL SEPARATOR
          SA2    M2
          SB7    B0          SET OCTAL CONVERSION
          SA1    A1+B1       SKIP SEPARATOR
          RJ     ASN         ASSEMBLE FIELD LENGTH
          BX5    X6
          SB6    A1          SAVE CHARACTER ADDRESS
          RJ     DXB         CONVERT FIELD LENGTH
          NZ     X4,ERS      IF CONVERSION ERROR
          BX5    X6
          AX6    12
          NZ     X6,ERS      IF FIELD LENGTH TOO LARGE
          SA1    FLOA
          MX0    42+6
          LX5    6
          LX0    6
          SEARCH TFLO,X1,X0  SEARCH TABLE FOR DUPLICATE ENTRY
          ZR     X2,FLO1     IF NO PREVIOUS ENTRY
          BX7    X5+X6       REPLACE ENTRY
          SA7    A2
          EQ     FLO2        LOOP
 
 FLOA     CON    0
 RES      SPACE  4,5
**        RES - DEFINE RESIDENCY.
 
 
 RES      SX0    B1
          LX0    17
          EQ     RES2
 
 RES1     SX0    0           SET MS RESIDENCY
 RES2     RJ     ARN         ASSEMBLE RECORD NAME
          SX7    A1          SAVE CHARACTER ADDRESS
          SA7    CA
          BX1    X6+X0       ENTER RESIDENCY TABLE
          RJ     ERT
 RES3     SA2    CA          CHECK SEPARATOR
          SA3    X2
          SA1    X2+B1
          SB2    X3-1R,
          ZR     B2,RES2     LOOP IF *,*
          EQ     ERS
 
 RES4     SA2    M2
          RJ     ASN         ASSEMBLE EST ORDINAL
          BX5    X6
          LX6    6
          SX4    X6-1R0
          NG     X4,RES6     IF DEVICE TYPE GIVEN
          SB7    0
          RJ     DXB         CONVERT EST ORDINAL
          NZ     X4,ERS
          SX7    A1+
          LX6    48
          MX0    12
          SA7    CA
          SEARCH TLST,X6,X0
 RES5     ZR     X2,ERS      IF ILLEGAL ALTERNATE DEVICE
          BX0    X6
          LX0    12+12
          SA6    AD
          EQ     RES3
 
 RES6     LX6    42
          MX0    12
          SX7    A1
          LX0    48
          SA7    CA
          SEARCH TLST,X6,X0
          BX6    -X0*X2
          EQ     RES5
 PPS      SPACE  4,5
**        PPS - DEFINE PPU SYNONYMS.
 
 
 PPS      SA2    M2          ASSEMBLE NAME
          RJ     ASN
          SX3    B1
          ERRNZ  PPRT-1
          BX0    X6+X3       SET NAME AND TYPE
          SX7    X1-1R/      CHECK NEXT CHARACTER
          NZ     X7,ERS      IF NOT */*
          SA1    A1+1        SKIP SEPARATOR
 PPS1     SA2    M2          ASSEMBLE SYNONYM
          RJ     ASN
          SB6    A1          SAVE SEPARATOR ADDRESS
          BX5    X6
          SB2    X1-1R,      CHECK SEPARATOR
          ADDWRD TSYN,X0     ENTER NAME
          ADDWRD A0,X5       ENTER SYNONYM
          NZ     B2,ERS      IF SEPARATOR NOT *,*
          SA1    B6+1        ADVANCE CHARACTER ADDRESS
          EQ     PPS1        LOOP
 SCC      SPACE  4,5
**        SCC - DEFINE RECORDS AS SCOPE CONTROL CARDS.
 
 
 SCC      RJ     ARN         ASSEMBLE RECORD NAME
          SX0    A1
          SB2    X1-1R,
          ADDWRD TSCC,X6     ENTER SCOPE RECORD TABLE
          NZ     B2,ERS      IF SEPARATOR NOT *,*
          SA1    X0+1
          EQ     SCC         LOOP
          SPACE  4
 KEYWD    HERE
          CON    0           TERMINATE TABLE
          TITLE  DIRECTIVE PROCESSING SUBROUTINES.
 ARN      SPACE  4
**        CHARACTER SENSE MASKS.
 
 
 M1       CON    37777777777765717777B MASK FOR ALL BUT < ,/->
 M2       CON    37777777777740000000B MASK FOR ALPHA/NUMERICS
 
 CA       CON    0           CHARACTER ADDRESS
 ARN      SPACE  4,15
**        ARN - ASSEMBLE RECORD NAME.
*
*         ENTRY  (A1) = ADDRESS OF CHARACTER.
*                (X1) = CHARACTER.
*
*         EXIT   (X6) = NAME AND TYPE.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - NONE.
*                X - 1, 2, 3, 4, 6, 7.
*
*         CALLS  ASN.
 
 
 ARN2     SA3    TY          ENTER TYPE
          BX6    X6+X3
 
 ARN      PS                 ENTRY/EXIT
          SA2    M1          ASSEMBLE NAME
          RJ     ASN
          SX7    X1-1R/      CHECK SEPARATOR
          NZ     X7,ARN2     IF NOT */*
          SA3    TRCN
          SA1    A1+B1       SKIP SEPARATOR
          MX2    42
 ARN1     ZR     X3,/ERR/TYP
          IX7    X3-X6
          BX4    X2*X7
          SA3    A3+B1
          NZ     X4,ARN1
          SA2    A2
          SX7    A3-TRCN-1   SET TYPE
          SA7    TY
          RJ     ASN         ASSEMBLE NAME
          EQ     ARN2
 ASN      SPACE  4,15
**        ASN - ASSEMBLE NAME.
*
*         ENTRY  (A1) = ADDRESS OF CHARACTER.
*                (X1) = CHARACTER.
*                (X2) = LEGAL CHARACTER MASK.
*
*         EXIT   (X6) = NAME.
*                (A1) = ADDRESS OF SEPARATOR CHARACTER.
*                (X1) = SEPARATOR CHARACTER.
*
*         USES   X - 1, 6, 7.
*                B - 2, 3, 4.
*                A - 1, 7.
 
 
 ASN1     LX6    6           ADVANCE ASSEMBLY
          SB2    B2-B3
          BX6    X6+X1
          SA1    A1+B1       NEXT CHARACTER
 ASN2     SB4    X1          CHECK CHARACTER
          LX7    X2,B4
          NG     X7,ASN1     IF NOT SEPARATOR
          LX6    X6,B2       LEFT JUSTIFY ASSEMBLY
          SX7    X6
          ZR     X6,/ERR/BKN IF BLANK NAME
          NZ     X7,/ERR/TMC IF MORE THAN 7 CHARACTERS
 
 ASN      PS                 ENTRY/EXIT
          SX7    A1
          SB2    60
          BX6    X6-X6       CLEAR ASSEMBLY
          SB3    6
          SA7    CA          SAVE CHARACTER ADDRESS
          EQ     ASN2
 CKW      SPACE  4,10
**        CKW - CHECK KEYWORD.
*         CHECK STRING BUFFER IMAGE FOR KEYWORD PROCESSING.
*  LIST   42/  NAME,18/  ADDR
*         NAME   KEYWORD
*         ADDR   ADDRESS OF PROCESSOR.
*                A ZERO WORD TERMINATES LIST.
*
*         ENTRY  (A0) = ADDRESS OF KEYWORD LIST.
*T,LIST   42/ NAME, 18/ ADDR
*         (B7) = COMMENT PROCESSOR.
*
*         EXIT   TO PROCESSOR IF KEYWORD FOUND.
 
 
 CKW      PS                 ENTRY/EXIT
          SA1    LBUF        CHECK FIRST CHARACTER
          SX6    X1-1R*
          SX7    A1          SET CHARACTER ADDRESS
          NZ     X6,CKW      RETURN IF NOT (*)
          SA1    A1+B1       SKIP (*)
          SA2    M2          SET NORMAL NAME MASK
          SX6    X1-1R/      CHECK FOR COMMENT DIRECTIVE
          SA7    CA
          ZR     X6,CKW2     IF COMMENT DIRECTIVE
          RJ     ASN         ASSEMBLE NAME
          SA2    A0          SET TABLE ADDRESS
          MX0    42
          SB2    -1R
 CKW1     IX4    X2-X6       COMPARE NAMES
          ZR     X2,CKW      RETURN IF END OF TABLE
          BX3    X0*X4
          SA2    A2+B1       NEXT ENTRY
          NZ     X3,CKW1     IF NO MATCH
          SA1    A1+B1       SKIP SEPARATOR
 +        SX6    X1+B2       CHECK NEXT CHARACTER
          SA1    A1+B1
          ZR     X6,*        LOOP IF SPACE
          SA1    A1-B1       SET CHARACTER ADDRESS
          SX6    A1
          SB2    X4          SET PROCESSOR ADDRESS
          SX7    B1          SET TYPE = PP
          ERRNZ  PPRT-1
          SA6    CA
          SA7    TY
          JP     B2          PROCESS KEYWORD
 
*         PROCESS COMMENT DIRECTIVE.
 
 CKW2     JP     B7          EXIT TO COMMENT PROCESSOR
          TITLE  UTILITY SUBROUTINES.
 ABT      SPACE  4,5
**        ABT - ABORT JOB.
*
*         ENTRY  (X0) = ADDRESS OF ABORT MESSAGE.
*
*         EXIT   JOB ABORTED.
 
 
 SFE      SA3    X0
          BX7    X3
          SA7    SFEB
          SX0    SFEA
 
 ABT      MESSAGE X0
+         SA3    DL          DETERMINE IF THIS IS A DEADSTART LOAD
          NZ     X3,*        IF DEADSTART LOAD
          SA1    SP          CHECK IF *SLL* PRESENT
          ZR     X1,ABT1     IF *SLL* NOT PRESENT
          SA1    .DPE        DROP *SLL* FOR ERROR CONDITION
          SX2    SL
          BX7    X1
          SA7    X2
          RECALL X2
 ABT1     RJ     CMF         COMPLETE FILES
          ABORT
 
 MOE      SX0    =C*MEMORY OVERFLOW.*
          EQ     ABT
 
 PLE      SX0    =C* PLD.*
          EQ     SFE
 
 RPE      SX0    =C* RPL.*
          EQ     SFE
 
 SFEA     DATA   20HSYSTEM FILE ERROR IN
 SFEB     CON    0,0L.
 BPH      SPACE  4,10
**        BPH - BUILD *PPL* HEADER.
*
*         ENTRY  ((A1)) = *PPL* TABLE HEADER.
*                ((A1)+1) = WORD 1 OF PREFIX TABLE.
*                (X0) = 77777700000000000000B.
*
*         EXIT   ((A1)) = *RPL* HEADER FOR *PPL* RECORD.
*                       = 18/ NAME,2/1,16/ LOAD ADDRESS,12/,12/ LENGTH.
*                (X0) = 77777700000000000000B.
*
*         EXIT   TO *RPE* IF NAME IS NOT 3 CHARACTERS.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 7.
 
 
 BPH      SUBR               ENTRY/EXIT
          SA1    A1          GET *PPL* HEADER
          MX6    -12
          SA2    A1+B1       GET NAME FROM PREFIX TABLE
          MX7    -32
          BX6    -X6*X1      GET LENGTH
          BX1    -X7*X1      GET LOAD ADDRESS
          BX7    X0*X2       GET NAME
          BX2    -X0*X2
          AX1    16
          AX2    18
          SX1    X1-5+1S16   GET LOAD ADDRESS AND 16-BIT FLAG
          NZ     X2,RPE      IF NOT 3 CHARACTER NAME
          LX1    24
          BX7    X7+X6       MERGE LENGTH
          BX7    X7+X1       MERGE LOAD ADDRESS
          SA7    A1
          EQ     BPHX        RETURN
 ERT      SPACE  4,10
**        ERT - ENTER RESIDENCY TABLE.
*
*         ENTRY  (X1) = ENTRY.
*
*         EXIT   (X6) = ENTRY.
*
*         USES   X - 1, 2, 4, 6, 7.
*                B - 2, 3.
*                A - 1, 6, 7.
 
 
 ERT1     BX7    X4*X2       COMPARE
          SA1    A1+1
          BX2    X6-X1
          NZ     X7,ERT1     LOOP TO HIT
          SB2    A1          CHECK SEARCH
          EQ     B2,B3,ERT   RETURN IF END OF TABLE
          SA6    A1-B1       REPLACE ENTRY FOUND
          SX7    X3-1        DECREMENT TABLE LENGTH
          SA7    L.TRES
 
 ERT      PS                 ENTRY/EXIT
          ADDWRD TRES,X1     ENTER RESIDENCY TABLE
          SA1    X2          FIRST ENTRY
          IX7    X2+X3       SET END OF TABLE
          MX4    42+12       SET MASK
          SB3    X7
          LX4    12
          BX2    X6-X1
          EQ     ERT1
 TOV      SPACE  4,15
**        TOV - MANAGED TABLE MEMORY OVERFLOW PROCESSOR.
*
*         ENTRY  (B6) = RETURN ADDRESS.
*
*         EXIT   TO *MOE* IF MEMORY NOT AVAILABLE.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 2.
*                X - 1, 2, 3, 6, 7.
*
*         MACROS MEMORY, MOVE, RECALL.
 
 
 TOV      SA1    F.TEND      FETCH END OF MANAGED TABLES
          SX7    X1+MINC
          NG     X7,MOE      IF INCREASE TOO LARGE
          SA3    TN
          SA7    A1          SET NEW END OF TABLES
          LX7    30          SET UP MEMORY REQUEST
          SA7    TOVA
          MEMORY ,A7,,,NA
          SB2    X3
          RECALL A7          WAIT REQUEST COMPLETE
          SA2    X2          CHECK REQUEST
          IX6    X2-X7
          SX1    B2-NTAB+1
          NG     X6,MOE      IF MEMORY NOT ASSIGNED
          SX7    MINC
          NZ     X1,TOV1     IF TABLE COUNT NOT CHANGED
          SA3    B2+FTAB-1
          RECALL F
          SA2    F+5
          IX6    X3+X7       MOVE LAST TABLE TO END OF FL
          SA6    A3
          SA1    B2+LTAB-1
          IX7    X2+X7       ADJUST LIST ADDRESS
          SA7    A2
          MOVE   X1,X3,X6
 TOV1     JP     B6          RETURN TO MANAGED TABLE PROCESSOR
 
 TOVA     CON    0           MEMORY REQUEST STATUS WORD
 WOF      SPACE  4,15
**        WOF - WRITE LINE TO OUTPUT.
*
*         ENTRY  (X1) = FWA LINE.
*                (X2) = WORD COUNT.
*                IF (X2) > 0, LINE IS *S* FORMAT.
*                IF (X2) = 0, LINE IS *C* FORMAT.
*
*         EXIT   (LC) ADVANCED.
*                (PN) ADVANCED.
*                (X2) = ADDRESS OF OUTPUT FET.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
 
 
 WOF2     WRITES X2,B6,B7
 
 WOF      CON    0           ENTRY/EXIT (LIST FLAG)
          SA3    LC          ADVANCE LINE COUNT
          SX6    X3+B1
          SA6    A3
          SA4    A3+B1       GET PAGE LENGTH
          IX7    X6-X4
          NG     X7,WOF1     IF BOTTOM OF PAGE NOT REACHED
          BX6    X1          SAVE REQUEST
          LX7    X2
          SA6    WOFA
          SA7    A6+B1
          SA1    PN          ADVANCE PAGE NUMBER
          SX7    X1+B1
          SX6    3           RESET LINE COUNT
          SA6    A3
          SA7    A1
          RJ     CDD         CONVERT PAGE NUMBER
          MX1    60-12
          LX6    4*6         STORE PAGE NUMBER
          BX6    X1*X6
          SA6    PAGE
          CLOCK  TIME
          WRITEW O,(=1H1),1
          SA1    TL
          WRITEW X2,X1,4
          WRITEW X2,TITL,TITLL
          WRITEC O,(=2L  )
          WRITEC O,(=2L  )
          SA1    WOFA        RESTORE REQUEST
          SA2    A1+B1
 WOF1     SB7    X2
          SB6    X1
          SX2    O
          NZ     B7,WOF2     IF *S* FORMAT
          WRITEC X2,B6
          EQ     WOF         RETURN
 
 WOFA     CON    0,0
 WTB      SPACE  4,15
**        WTB - WRITE BLOCK.
*         WRITE BLOCK TO SYSTEM FILE VIA *SLL* BUFFER.
*         *SLL* IS PRESUMED TO BE ACTIVE.
*
*         ENTRY  (WC) = WORD COUNT OF BLOCK.
*                (BUF - BUF+77B) = BLOCK.
*
*         EXIT   (SN) ADVANCED BY 1.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - NONE.
*                A - 1, 2, 3, 4, 6, 7.
 
 
 WTB      PS                 ENTRY/EXIT
          SA1    WC          WRITE BLOCK
          WRITEW S,A1,X1+B1
          SA1    SN          ADVANCE SECTOR NUMBER
          SA2    S+6         ADVANCE SECTOR COUNT
          SX3    B1
          IX6    X1+X3
          IX7    X2+X3
          SA6    A1
          SA7    A2
          EQ     WTB         RETURN
          SPACE  4,5
**        COMMON DECKS.
 
 
*CALL     COMCCIO
*CALL     COMCCDD
*CALL     COMCCVL
*CALL     COMCCPT
*CALL     COMCMTP
*CALL     COMCMVE
*CALL     COMCRDS
*CALL     COMCRDW
*CALL     COMCSFN
*CALL     COMCSRT
*CALL     COMCSST
*CALL     COMCSTF
*CALL     COMCSYS
*CALL     COMCWTC
*CALL     COMCWTS
*CALL     COMCWTW
*CALL     COMCDXB
*CALL     COMCLFM
          TITLE  DIRECTIVE CARD PROCESSING.
          QUAL   RDC
 
 I        BSS    0
 INPUT    FILEC  IBUF,IBUFL,(FET=8)
 
 LC       CON    0           LIBRARY CHANGE FLAG
 ZO       CON    0           NON-ZERO IF *Z* OPTION SELECTED
 RDC      SPACE  4,5
**        RDC - READ DIRECTIVE CARDS.
 
 
 RDC2     SA1    LC
          ZR     X1,RDC3     IF NO LIBRARY CHANGES
          WRITER S           DUMP SCRATCH FILE
          SA2    S           ADD FILE TO FILE TABLE
          MX3    42
          ADDWRD TFIL,X3*X2
          SA1    SC          SET SYSTEM CHANGE FLAG
          SX6    X1+B1
          SA6    A1
 RDC3     RECALL S
          SA1    X2+B1       SET IN = OUT = FIRST
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
 
 RDC      PS                 ENTRY/EXIT
          SX7    0
          SA1    I
          SX6    RDC1        SET ERROR RETURN
          SA7    EC          CLEAR ERROR COUNT
          SA2    ZO
          SA6    ER          SET ERROR RETURN
          NZ     X2,RDC1     IF *Z* OPTION SELECTED
          ZR     X1,RDC3     IF NO INPUT FILE
          SX2    I           CHECK FOR TERMINAL INPUT
          RJ     STF
          ZR     X6,RDC1.1   IF INPUT ASSIGNED TO TERMINAL
          READ   I
 RDC1     READS  I,LBUF,LBUFL READ DIRECTIVE CARD
          NZ     X1,RDC2     IF EOR
 
*         PROCESS KEYWORDS.
 
 
          SB7    COM         SET COMMENT PROCESSOR ADDRESS
          KEYWD  AD,ADR
          KEYWD  CM,CMR
          KEYWD  D,DELETE
          KEYWD  DELETE
          KEYWD  FILE
          KEYWD  FL,FLO
          KEYWD  IGNORE
          KEYWD  MS,MSR
          KEYWD  PPSYN
          KEYWD  PROC,LDC    *PROC ACCEPTED BUT NO LONGER REQUIRED
          KEYWD  SC,SCC
 
          EQ     /ERR/ILD    ILLEGAL DIRECTIVE
 
 RDC1.1   SX0    =C/ TERMINAL INPUT NOT VALID. USE *I* OR *Z* OPTION./
          EQ     ABT         ABORT
 AD       SPACE  4,5
***       *AD    E,TY1/REC1,TY2/REC2,...,TYN/RECN
*
*         DEFINE MASS STORAGE RESIDENCY ON ALTERNATE EQUIPMENT
*         *E* FOR RECORDS *TYN/RECN*
 
 
 ADR      SA2    M2
          RJ     ASN
          SB2    X1-1R,      CHECK SEPARATOR
          SA1    A1+1
          NZ     B2,/ERR/ISP IF NOT COMMA
          SA2    ADRA        MASK FOR PERMISSIBLE RECORD TYPES
          JP     CMR1
 
 
*         MASK FOR PERMISSIBLE *AD RECORD TYPES.
 
 ADRA     CONRT  (PPRT,RLRT,OVRT,ABRT,PLRT),60
 CM       SPACE  4,5
***       *CM    TY1/REC1,TY2/REC2,...,TYN/RECN
*
*         DEFINE CENTRAL MEMORY RESIDENCY FOR RECORDS *TYN/RECN*.
 
 
 CMR      SA2    CMRB        MASK FOR PERMISSIBLE RECORD TYPES
 
 CMR1     BX7    X2
          SA7    CMRA
 CMR2     RJ     ARN         ASSEMBLE RECORD NAME
          SA2    CMRA        CHECK TYPE
          SB2    X6
          LX3    X2,B2
          PL     X3,/ERR/ICM IF NOT LEGAL CM/AD RESIDENCE
          SB2    X1-1R       CHECK SEPARATOR
          ZR     B2,ALC      IF END OF DIRECTIVE
          SA1    A1+1        SKIP SEPARATOR
          EQ     B2,B1,CMR2  IF *,*
          EQ     /ERR/ISP    ILLEGAL SEPARATOR
 
 
 CMRA     CON    0
*         CONRT  (PPRT,RLRT,OVRT,ABRT,PLRT),60  IF *AD DIRECTIVE
*         CONRT  (PPRT,OVRT,ABRT,PLRT),60  IF *CM DIRECTIVE
 
*         MASK FOR PERMISSIBLE *CM RECORD TYPES.
 
 CMRB     CONRT  (PPRT,OVRT,ABRT,PLRT),60
 COM      SPACE  4,10
***       */ - COMMENT.
*
*         INSERT COMMENTS IN LIBDECK AND ON LISTING.
 
 
 COM      BSS    0
          EQ     ALC         LIST DIRECTIVE
 MS       SPACE  4,5
***       *MS    TY1/REC1,TY2/REC2,...,TYN/RECN
*
*         DEFINE MASS STORAGE RESIDENCY FOR RECORDS *TYN/RECN*.
 
 
 MSR      RJ     ARN         ASSEMBLE RECORD NAME
          SB2    X1-1R       CHECK SEPARATOR
          ZR     B2,ALC      ADD LIBRARY CHANGE IF * *
          SA1    A1+1        SKIP SEPARATOR
          EQ     B2,B1,MSR   IF *,*
          EQ     /ERR/ISP
 DELETE   SPACE  4,5
***       *DELETE TY1/REC1,TY2/REC2,...,TYN/RECN
*         *D      TY1/REC1,TY2/REC2,...,TYN/RECN
*
*         DELETE RECORDS *TYN/RECN* FROM SYSTEM LIBRARY.
 
 
 DELETE   RJ     ARN         ASSEMBLE RECORD NAME
          SB6    A1          SAVE SEPARATOR ADDRESS
          SB2    X1-1R
          SEARCH TRCD,X6     SEARCH FOR RECORD
          ZR     X2,/ERR/RNF IF NOT FOUND
          SX1    X2-ULRT     CHECK TYPE = *ULIB*
          ZR     X1,DEL1     IF *ULIB*
          ADDWRD TDLT,X2     ENTER DELETE TABLE
          SA1    SC          SET SYSTEM CHANGE FLAG
          SX6    X1+B1
          SA6    A1
 DEL1     ZR     B2,LDC      IF END OF DIRECTIVE
          SA1    B6+1        ADVANCE CHARACTER ADDRESS
          EQ     B2,B1,DELETE LOOP IF *,*
          EQ     /ERR/ISP
 FILE     SPACE  4,5
***       *FILE  LFN
*         *FILE  LFN,NR
*
*         DEFINE FILE *LFN* AS A SYSTEM CHANGE FILE.  IF *NR* IS
*         NOT PRESENT, *LFN* WILL BE REWOUND BEFORE PROCESSING.
 
 
 FILE     SA2    M2          ASSEMBLE NAME
          RJ     ASN
          SB2    X1-1R       CHECK SEPARATOR
          ZR     B2,FIL1     IF SPACE
          NE     B2,B1,/ERR/NME IF NOT *,*
          SA1    A1+B1       SKIP SEPARATOR
          BX5    X6
          RJ     ASN
          SB2    X1-1R
          NZ     B2,/ERR/IFS IF NOT SPACE
          LX6    18
          SX2    B1
          SX7    X6-2LNR
          NZ     X7,/ERR/IFS IF NOT *NR*
          BX6    X5+X2
 FIL1     ADDWRD TFIL,X6     ENTER FILE NAME
          SA1    SC          SET SYSTEM CHANGE FLAG
          SX6    X1+B1
          SA6    A1
          EQ     LDC         LIST DIRECTIVE
 FL       SPACE  4,5
***       *FL    TY1/REC1-FL1,TY2/REC2-FL2,...,TYN/RECN-FLN
*
*         SET FIELD LENGTH OVERRIDE *FLN* FOR RECORD *TYN/RECN*.
 
 
 FLO      RJ     ARN         ASSEMBLE RECORD NAME
          SB2    X1-1R-      CHECK SEPARATOR
          SB7    B0          SET OCTAL CONVERSION
          SA1    A1+B1       SKIP SEPARATOR
          NZ     B2,/ERR/ISP IF ILLEGAL SEPARATOR
          SA2    M2
          RJ     ASN         ASSEMBLE FIELD LENGTH
          SB6    A1          SAVE CHARACTER ADDRESS
          BX5    X6          CONVERT FIELD LENGTH
          RJ     DXB
          NZ     X4,/ERR/ILD IF CONVERSION ERROR
          AX6    12
          SA2    B6
          NZ     X6,/ERR/ILD IF FIELD LENGTH TOO LARGE
          SB2    X2-1R       CHECK SEPARATOR
          ZR     B2,ALC      IF END OF DIRECTIVE
          SA1    B6+1        SKIP SEPARATOR
          EQ     B2,B1,FLO   LOOP IF *,*
          JP     /ERR/ISP    ILLEGAL SEPARATOR
 IGNORE   SPACE  4,5
***       *IGNORE TY1/REC1,TY2/REC2,...,TYN/RECN
*
*         IGNORE RECORDS *TYN/RECN* ON CURRENT CHANGE FILE.
 
 
 IGNORE   SA2    L.TFIL      SET FILE INDEX
          SX0    X2-1
          LX0    12
 IGN1     RJ     ARN         ASSEMBLE RECORD NAME
          SB6    A1          SAVE CHARACTER ADDRESS
          SB2    X1-1R
          ADDWRD TINR,X6+X0  ENTER RECORD IGNORE TABLE
          ZR     B2,LDC      IF END OF DIRECTIVE
          SA1    B6+1
          EQ     B2,B1,IGN1  IF *,*
          EQ     /ERR/ISP    ILLEGAL SEPARATOR
 PPSYN    SPACE  4,5
***       *PPSYN NAM/NAM1,NAM2,...,NAMN
*
*         ADD ENTRIES TO LIBRARY TO PROVIDE SYNONYMS *NAMN* FOR
*         PPU PROGRAM *NAM*.
 
 
 PPSYN    SA2    M2          ASSEMBLE NAME
          RJ     ASN
          SB2    X1-1R/      CHECK SEPARATOR
          SA1    A1+1        SKIP SEPARATOR
          NZ     B2,/ERR/ISP IF NOT */*
          MX2    -42         CHECK NAME
          BX7    -X2*X6
          NZ     X7,/ERR/IPN
          LX6    6
          SX3    X6-1R0
          PL     X3,/ERR/IPN IF NUMERIC
 PPS1     SA2    M2          ASSEMBLE SYNONYM
          RJ     ASN
          MX2    -42         CHECK NAME
          BX7    -X2*X6
          NZ     X7,/ERR/IPN
          LX6    6
          SX3    X6-1R0
          PL     X3,/ERR/IPN IF NUMERIC
          SB2    X1-1R       CHECK SEPARATOR
          ZR     B2,ALC      IF * *
          SA1    A1+1
          EQ     B2,B1,PPS1  LOOP IF *,*
          EQ     /ERR/ISP
 SC       SPACE  4,5
***       *SC    TY1/REC1,TY2/REC2,...,TYN/RECN
*
*         DEFINE RECORDS *TYN/RECN* AS SCOPE CONTROL CARDS.
 
 
 SCC      RJ     ARN         ASSEMBLE RECORD NAME
          SA2    SCCA
          SB2    X6          SET TYPE
          LX3    B2,X2
          PL     X3,/ERR/ISR IF NOT *OVL*/*ABS*
          SB2    X1-1R
          ZR     B2,ALC      ADD LIBRARY CHANGE IF * *
          SA1    A1+1
          EQ     B2,B1,SCC   IF *,*
          JP     /ERR/ISP    ILLEGAL SEPARATOR
 
 
 SCCA     CONRT  (RLRT,OVRT,ABRT),60  MASK FOR REL, OVL OR ABS
          TITLE  DIRECTIVE PROCESSING ROUTINES.
 ALC      SPACE  4,5
**        ALC - ADD LIBRARY CONTROL.
*
*         EXIT   (LC) SET.
 
 
 ALC      WRITES S,LBUF,LBUFL WRITE CARD TO SCRATCH FILE
          SX6    1           SET LIBRARY CONTROL FLAG
          SA6    LC
          EQ     LDC         LIST DIRECTIVE
 ERR      SPACE  4,5
**        ERROR PROCESSOR.
 
 
          QUAL   ERR
 
 BKN      SX0    =C*BLANK NAME FIELD.*
          EQ     /RDC/LDC1
 
 ICM      SX0    =C*ILLEGAL CM/AD RESIDENCE.*
          EQ     /RDC/LDC1
 
 IFS      SX0    =C*ILLEGAL FILE SPECIFICATION.*
          EQ     /RDC/LDC1
 
 ILD      SX0    =C*ILLEGAL DIRECTIVE.*
          EQ     /RDC/LDC1
 
 IPN      SX0    =C*ILLEGAL PPU PROGRAM NAME.*
          EQ     /RDC/LDC1
 
 ISP      SX0    =C*ILLEGAL SEPARATOR.*
          SX6    A1-1
          SA6    CA
          EQ     /RDC/LDC1
 
 ISR      SX0    =C*ILLEGAL RECORD, MUST BE REL, OVL OR ABS.*
          EQ     /RDC/LDC1
 
 NME      SX0    =C*ILLEGAL CHARACTER IN NAME.*
          EQ     /RDC/LDC1   LIST ILLEGAL DIRECTIVE
 
 RNF      SX0    =C*RECORD NOT FOUND.*
          EQ     /RDC/LDC1
 
 TMC      SX0    =C*TOO MANY CHARACTERS IN NAME FIELD.*
          EQ     /RDC/LDC1
 
 TYP      SX0    =C*ILLEGAL RECORD TYPE.*
          EQ     /RDC/LDC1
 
          QUAL   *
 LDC      SPACE  4,5
**        LDC - LIST DIRECTIVE CARD.
*
*         ENTRY  (X0) = ADDRESS OF ERROR MESSAGE.
 
 
 LDC      SX0    0
 LDC1     ZR     X0,LDC2     IF NO ERROR MESSAGE
          SA1    =10H  *ERROR*
          MX2    -6          ENTER ERROR CODE
          SB2    -10
          LX1    6
 +        BX6    -X2*X1
          LX1    6
          SA6    LBUF+B2
          SB2    B2+B1
          NG     B2,*-1
          SA1    O           CHECK OUTPUT FILE
          NZ     X1,LDC2     IF DEFINED
          SA2    =0LOUTPUT   SET FILE NAME
          SX3    15B
          BX6    X2+X3
          SX7    99999       FORCE EJECT
          SA6    A1
          SA7    //LC
 LDC2     PRINT  LBUF-10,LBUFL+10
          ZR     X0,RDC1     IF NO ERROR MESSAGE
          SX7    1R          CLEAR LBUFFER
          SB2    LBUFL+10
          SA7    LBUF-10
 +        SA7    A7+B1
          SB2    B2-B1
          NE     B2,B1,*
          SA1    CA          ENTER POINTER TO ERROR
          SX6    1R*
          SA6    X1
          WRITES O,LBUF-10,LBUFL+10
          WRITEW O,(=10H  ******  ),1
          WRITEC O,X0
          SA1    //LC        ADVANCE LINE COUNT
          SA2    EC          ADVANCE ERROR COUNT
          SX6    X1+2
          SA3    ER          READ ERROR RETURN
          SX7    X2+B1
          SA6    A1
          SB2    X3
          SA7    A2
          JP     B2
          SPACE  4
 KEYWD    HERE
          CON    0           TERMINATE TABLE
          TITLE  DATA AND LBUFFERS.
          QUAL
 TRCN     SPACE  4,10
**        TRCN - TABLE OF RECORD NAMES.
*         ENTRY = 1 WORD.
*         INDEXED BY RECORD TYPE CODE.
*
*T        42/  TYPE,18/
*         TYPE   RECORD TYPE NAME
 
 
 TRCN     BSS    0
          LOC    0
 
 .E       ECHO   ,RT=("RTMIC")
 .A       IFC    NE,/RT//
          DATA   L/RT/
 .A       ELSE
          DATA   -1
 .A       ENDIF
 .E       ENDD
 
          LOC    *O
          CON    0           TABLE TERMINATOR
 PLR      SPACE  4,10
**        PLR - PROCESS LIBDECK RECORD.
*
*         EXIT   LIBDECK RECORD COPIED TO SCRATCH FILE *SCR*.
 
 
 PLR      READS  F,LBUF,LBUFL READ DIRECTIVE CARD
          NZ     X1,SYE      IF EOR/EOF
          RJ     ERS         ENTER RESIDENCY STATUS
          WRITES S,LBUF,LBUFL COPY DIRECTIVE TO SCRATCH FILE
          EQ     PLR         LOOP
 TITL     SPACE  4,5
*         TITLE LINE.
 
 
 TITL     DATA   20H
          DATA   20HSYSEDIT - VER 1.
 DATE     DATA   1H
 TIME     DATA   1H
          DATA   4APAGE
 PAGE     DATA   1H
 TITLL    EQU    *-TITL
 BUFFERS  SPACE  4,5
*         BUFFERS.
 
 
          USE    //
          SEG
 WC       CON    0           SECTOR WORD COUNT
 BUF      BSS    100B        SECTOR BUFFER
 BUFL     EQU    *-BUF
 
          DUP    10,1        LEADING SPACES FOR LIST
          CON    1R
 LBUF     EQU    *
 IBUF     EQU    LBUF+LBUFL+1
 OBUF     EQU    IBUF+IBUFL
 FBUF     EQU    OBUF+OBUFL
 SBUF     EQU    FBUF+FBUFL
 MEML     EQU    SBUF+SBUFL
          TITLE  PRESET ROUTINES.
 PRS      SPACE  4,5
**        PRS - PRESET PROGRAM.
 
 
          ORG    OBUF
 SYSEDIT  SX6    A0-10B      SET END OF MANAGED TABLES
          SA6    F.TEND
          SB1    1
          DATE   DATE        SET DATE
          GETPP  BUF,LL,BUF  GET PAGE SIZE PARAMETERS
          WRITEC O,BUF       WRITE PRINT DENSITY FORMAT EFFECTOR
          SA1    ACTR        CHECK ARGUMENT COUNT
          SB4    X1+
          ZR     X1,PRS1     IF NO ARGUMENTS
          SA4    ARGR        FIRST ARGUMENT
          SB5    PRSA
          RJ     ARG         PROCESS ARGUMENTS
 PRS1     NZ     X1,PRS7     IF ARGUMENT ERROR
          SYSTEM RSB,R,PRSJ
          SA1    PRSK
          LX1    59-30
          NG     X1,PRS1.1   IF *PROBE* DISABLED
          SX7    3           SET CHECKPOINT FLAG
          SA7    CF
 PRS1.1   SA3    PRSB
          BX6    X3          SET POINTER TO OUTPUT FET
          MX7    0
          SA6    B1+B1
          SA7    A6+B1
          SA7    LS          CLEAR LIBDECK NOT FOUND FLAG
          SA1    CCDR-1      SPACE FILL CONTROL STATEMENT
          SB7    4
 PRS2     SA1    A1+B1
          SB7    B7-B1
          RJ     SFN
          SA6    A1
          NZ     B7,PRS2
          SA1    /RDC/ZO     CHECK *Z* OPTION
          ZR     X1,PRS3     IF *Z* NOT SELECTED
          SX2    /RDC/I      INPUT FET ADDRESS
          RJ     ZAP         PROCESS *Z* OPTION
 PRS3     SA1    PRSD        CHECK BINARY FILE NAME
          ZR     X1,PRS4     IF NO BINARY FILE
          MX0    42
          ADDWRD TFIL,X0*X1  ENTER BINARY FILE
          SX6    B1+         SET SYSTEM CHANGE FLAG
          SA6    SC
 PRS4     SA5    PRSE
          ZR     X5,PRS5     IF NO RESTORE OPTION
          SX6    B1          SET SYSTEM CHANGE FLAG
          SA6    SC
          SB7    B1
          RJ     DXB
          NZ     X4,PRS7     IF ASSEMBLY ERROR
          SX5    X6+B1
 PRS5     SA1    O           CHECK OUTPUT FILE
          AX1    18
          BX6    X6-X6
          NZ     X1,PRS6     IF OUTPUT FILE SPECIFIED
          SA6    O
 PRS6     RJ     ISF         INITIALIZE SYSTEM FILE
          SX2    S
          SA3    PRSG        SET SCRATCH FILE NAME
          BX7    X3
          SA7    X2
          RETURN X2,R
          SA4    LN          SEARCH FOR LIBDECK
          SEARCH TRCD,X4
          ZR     X2,PRS8     IF LIBDECK NOT FOUND
          SA1    A2+B1       SET RANDOM INDEX
          BX6    X1
          SA6    F+6
          READ   F
          EQ     PLR         PROCESS LIBDECK
 
 PRS7     SX0    =C*SYSEDIT ARGUMENT ERROR.*
          EQ     ABT
 
 PRS8     WRITEW S,A4,B1     CREATE LIBDECK
          JP     SYE
 
 PRSA     BSS    0
 I        ARG    (/RDC/I),(/RDC/I)
 L        ARG    PRSC,O
 B        ARG    PRSD,PRSD
 R        ARG    PRSF,PRSE
 C        ARG    PRSH,CF
 Z        ARG    -*,(/RDC/ZO)
 NA       ARG    -NZ,PRSI
          CON    0
 
 PRSB     CON    0LOUTPUT+O
 PRSC     CON    0LOUTPUT+15B
 PRSD     CON    0LLGO
 PRSE     CON    0
 PRSF     CON    0L0
 PRSG     CON    0LSCR+3
 PRSH     CON    3
 PRSI     CON    0
 PRSJ     VFD    12/0,12/1,18/SSTL,18/PRSK
 PRSK     CON    -1
 
 NZ       CON    1           NON-ZERO WORD FOR ARG. DEFAULT
 ISF      SPACE  4,5
**        ISF - INITIALIZE SYSTEM FILE.
*
*         ENTRY  (X5) = RESTORE NUMBER.
 
 
 ISF6     ALLOC  TLST,31     ALLOCATE SPACE FOR ASR DEVICES
          SA1    F.TLST
          SA2    .EAD
          LX1    12
          BX7    X2+X1
          SA7    SL
          RECALL A7
          SA1    ISFB        PUT DSD TEXT OVERLAY IN BEGINNING OF RPL
          ADDWRD TRES,X1
          SA1    LN
          SA3    DL
          BX7    X1          SET LIBDECK NAME IN ERROR MESSAGE
          SA7    ERSA+1
          SA7    SYEC+2
          NZ     X3,SYE1     IF DEAD START LOAD
 
 ISF      PS                 ENTRY/EXIT
          RETURN F,R         RETURN *SYSTEM*
          SA3    S
          BX6    X5          SET RESTORE NUMBER
          SX2    A3
          SA6    T2
          RETURN X2,R        RETURN *PPULIB*
          SA1    S+9
          SX6    3
          BX7    X1+X6
          SA7    A3          RETURN *ALTSYS*
          RETURN X2,R
          BX7    X3          RESTORE FET
          SA7    A3
          SA1    PRSI
          SYSTEM  SLL,,SL,X1
          RECALL SL
          SX7    B1+         SET *SLL* PRESENT FLAG
          SA7    SP
          SKIPEI S
          SKIPEI F,R
          RECALL S
          SA1    F+6         SET SYSTEM FILE EOI
          SA2    S+6         SET PPU LIBRARY EOI
          BX6    X1
          AX2    30
          BX7    X2
          AX6    30
          SA6    SN
          SA7    PE
          SKIPB  F,2
          READ   F
 ISF1     READW  F,T1,1      READ FIRST WORD
          SA2    T1          CHECK FIRST WORD
          NZ     X1,ISF5     IF EOR/EOF
          LX2    18
          SX6    X2-770000B
          LX2    6
          SB2    X2-16B      CHECK WORD COUNT
          NZ     X6,ISF5     IF NOT 7700 TABLE
          NZ     B2,ISF5     IF WRONG WORD COUNT
          READW  F,BUF,17B   READ 7700 TABLE
          SA5    BUF+16B     CHECK FIRST WORD
          SX1    X5
          LX5    18
          SX6    X5-700000B
          NZ     X6,ISF5     IF NOT 7000 TABLE
          ALLOC  TRCD,X1     ALLOCATE FOR TABLE
          READW  F,X2,X3
          SA1    BUF         SET DIRECTORY NAME
          SA2    F.TRCD      SET SEARCH PARAMETERS
          BX7    X1
          SA3    L.TRCD
          SB2    B1+B1
          SA5    T2          SET RESTORE COUNT
          SA7    WDRA+1
          BX6    X6-X6
          SA1    X2          FIRST WORD
          SB3    X3
          SA3    =C*(00)*
 ISF2     NZ     X1,ISF2.1   IF NOT ZERO LENGTH RECORD ENTRY
          BX7    X3
          SA7    A1          CHANGE RECORD NAME
 ISF2.1   SX7    X1-ODRT     CHECK RECORD TYPE
          SB3    B3-B2
          SA1    A1+B2
          NZ     X7,ISF3     IF NOT OPLD
          SX6    X6+B1       COUNT OPLD
          ZR     X5,ISF3     IF NO RESTORE REQUESTED
          SX5    X5-1        COUNT CHANGE
          ZR     X5,ISF4     IF FOUND
 ISF3     NZ     B3,ISF2     LOOP TO END OF TABLE
          SA6    CN          SET CHANGE NUMBER
          ZR     X5,ISF6
          SX0    =C*REQUESTED RESTORATION NOT FOUND.*
          EQ     ABT
 
 ISF4     SA4    A1-B1       SET RANDOM ADDRESS
          MX7    0           CLEAR RESTORE COUNT
          SA7    A5
          SA7    L.TRCD      CLEAR RECORD TABLE
          RECALL F
          BX6    X4
          SA6    F+6
          READ   F           BEGIN READ
          EQ     ISF1
 
 ISF5     SX0    =C*SYSTEM FILE FORMAT ERROR.*
          EQ     ABT
 
 ISFA     CON    0
 ISFB     VFD    42/0L9TA,6/40B,12/1
          SPACE  4
**        COMMON DECKS.
 
 
 QUAL$    EQU    1           PREVENT QUALIFICATION
*CALL     COMCARG
*CALL     COMCCPM
*CALL     COMCUSB
*CALL     COMCZAP
 DSL      SPACE  4,5
**        DSL - DEAD START LOAD.
 
 
 DSL1     SX6    A0-10B      SET FIELD LENGTH
          SA6    F.TEND
          MX6    0           CLEAR OUTPUT FET
          SA6    O
          SA1    DSLB        ENTER TAPE FILE
          ADDWRD TFIL,X1
          SX7    SL          SET *SLL* CONTROL WORD ADDRESS
          SA6    F           SET FILE NAME IN FET
          SX6    F           SET FET ADDRESS
          SA6    B1+B1
          SA7    A6+B1
          SA5    .DS1        CHANGE MODE INSTRUCTION
          SA2    DSLC        CHANGE MESSAGE
          MX3    42
          BX6    X3*X5
          LX7    X2
          SA6    A5
          SA7    CPFA
          RECALL SL
          SX6    1           SET DEAD START LOAD FLAG
          SA6    DL
          SA6    SC          SET SYSTEM CHANGE
          ZR     B3,ISF6     IF TAPE DEADSTART
          SA3    DSLD
          BX6    X3          MODIFY INSTRUCTIONS FOR DISK DEADSTART
          SA6    A5
          READCW F,17B
          EQ     ISF6
 
 DSLA     SA5    RDBA
          EQ     RDB4        (DEADSTART LOAD)
 
 DSLB     CON    0LSDF+3
 
 DSLC     CON    10H LOADING
 
 DSLD     EQ     CCF2        (DISK DEADSTART)
 
 RFL=     EQU    MEML+11000B
 
          END