Retro1.org codex

          IDENT  LDD,/LDD/LDD
          PERIPH
          BASE   MIXED
          SST
 IRA$     EQU    1           SET USER RANDOM ADDRESS INITIALIZATION
 MSR$     EQU    1           SET USER MASS STORAGE ERROR PROCESSING
 QUAL$    EQU    1           SET UNQUALIFIED COMMON DECKS
*COMMENT  FDL - LOAD FAST DYNAMIC LOAD DIRECTORIES.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  LDD - LOAD FAST DYNAMIC LOAD DIRECTORIES.
          SPACE  4,10
***       LDD - LOAD FAST DYNAMIC LOAD DIRECTORIES.
*         S. L. KSANDER.     76/04/01.
          SPACE  4,10
***              LDD PROCESSES THE PHYSICAL LOADING OF FAST DYNAMIC
*         LOAD CAPSULE DIRECTORY INFORMATION INTO THE USER SPECIFIED
*         AREA.  IF A FUNCTION CODE OF 404 IS PRESENT THEN
*         CCL PROCEDURE RECORDS ARE LOCATED RATHER THAN CAPSULES.
          SPACE  4,10
***       CALL FORMAT.
*
*
*T        18/ *LDD* ,1/,1/A,4/,12/ DI,6/ RSTAT,1/B,17/ FET
*
*         A      AUTO RECALL.
*         DI     DIRECTORY INDEX. (*LDD* RECALL ONLY)
*         RSTAT  RECALL STATUS BITS. (*LDD* RECALL ONLY)
*                2/LOCAL USER LIBRARY OFFSET.
*                4/GLOBAL LIBRARY SET INDEX.
*         B      *LDD* RECALL STATUS.
*
*
*         FET.
*
*T  FET   42/  *GROUP*,9/ STATUS,9/  CODE
*T,       12/,18/ LIST,12/ DIRL,18/ DIRA
*
*         INITIAL CALL.
*
*         GROUP  NAME OF GROUP FOR WHICH DIRECTORY INFORMATION IS
*                REQUESTED
*         STATUS IGNORED
*         CODE   FUNCTION CODE.
*                0 = LOCATE CAPSULES.
*                402 = LOCATE TEXT RECORD IN *CLD*.
*                404 = LOCATE TEXT RECORDS.
*         LIST   ADDRESS OF LIBRARY NAME LIST THAT IS TO BE SEARCHED
*                AFTER THE GLOBAL LIBRARY SET, TERMINATED BY ZERO WORD
*         DIRL   LENGTH OF DIRECTORY STORAGE AREA
*         DIRA   BASE ADDRESS OF DIRECTORY AREA
*
*
*         CALL COMPLETION.
*
*         GROUP  NOT CHANGED
*         STATUS 000 = NO ERRORS
*                001 = ILLEGAL FUNCTION CODE
*                002 = BAD DIRECTORY ADDRESS AND/OR LENGTH (OUTSIDE OF
*                      JOB FL)
*                003 = BAD LIBLIST ADDRESS AND/OR LENGTH (OUTSIDE OF
*                      JOB FL)
*                010 = LIBRARY NOT FOUND OR LIBRARY NOT MASS STORAGE
*                      RESIDENT
*                020 = INSUFFICIENT DIRECTORY SPACE GIVEN
*         CODE   SET TO 001
*         LIST   NOT CHANGED
*         DIRL   SET TO ACTUAL LENGTH REQUIRED
*         DIRA   NOT CHANGED
*
*         *LDD* RECALL.
*
*         AFTER EACH LIBRARY HAS BEEN PROCESSED, *LDD* WILL CHECK
*         THE TOTAL NUMBER OF SECTORS READ AGAINST THE ASSEMBLY
*         CONSTANT *RSLM*.  IF THIS LIMIT IS EXCEEDED, *LDD* WILL
*         PLACE ITSELF IN RECALL AND RESTART AGAIN WHEN IT IS
*         RECALLED.
*
*
*         DIRECTORY ENTRY FORMAT.
*
*
*         SYSTEM FILE DIRECTORY ENTRY.
*
*T DIRA   12/7777,12/  0,12/  FNT,6/ ORD,18/  0
*T,DIRA+1 42/ NAME, 18/ INDEX
*T,DIRA+2 1/1,23/  0,18/  PRU,18/  LENGTH
*
*
*         LOCAL FILE DIRECTORY ENTRY.
*
*T DIRA   1/1,41/  *LFN*,18/  0
*T,DIRA+1 42/ NAME, 18/ INDEX
*T,DIRA+2 1/1,23/  0,18/  PRU,18/  LENGTH
*
*
*         FNT      ADDRESS OF SYSTEM FILE FNT ENTRY
*         ORD      ORDINAL OF SYSTEM LIBRARY IN LIBRARY NAME TABLE
*         LFN      LOCAL FILE NAME
*         NAME     NAME OF CAPSULE OR TEXT RECORD.
*         INDEX    INDEX RELATIVE TO START OF DIRECTORY OF THE FILE
*                  ENTRY ASSOCIATED WITH THIS NAME.
*         PRU      DISK ADDRESS OF FIRST SECTOR OF CAPSULE OR TEXT
*                  RECORD.
*         LENGTH   LENGTH OF CAPSULE OR TEXT RECORD.
          SPACE  4,15
***       DAYFILE MESSAGES.
*
*         * LDD - ARGUMENT ERROR - XXXXXX.* = FET ADDRESS .LT. 2 OR
*         .GT. FL-2.
*
*         * LDD - I/O SEQUENCE ERROR - FILENAM AT XXXXXX.* = MULTIPLE
*         CONCURRENT FUNCTIONS WERE ATTEMPTED ON FILE *FILENAM*.
*
*         * LDD - DEVICE ERROR - FILENAM AT XXXXXX.* = AN UNRECOVERED
*         DEVICE ERROR WAS ENCOUNTERED ON FILE *FILENAM*.
*
*         FOR ALL MESSAGES, XXXXXX IS THE ADDRESS OF THE *LDD*
*         PARAMETER BLOCK.
          SPACE  4,10
***       OPERATOR MESSAGES.
*
*
*         NONE.
          SPACE  4,25
****      ASSEMBLY CONSTANTS.
 
 
          QUAL   ERR         ERROR CODES.
 ILF      EQU    1           ILLEGAL FUNCTION
 IAD      EQU    2           ILLEGAL ADDRESS
 FNF      EQU    3           FILE NOT FOUND (LDQ)
 ILA      EQU    3           ILLEGAL LIBLIST ADDRESS (LDD)
 IRA      EQU    4           ILLEGAL RANDOM ADDRESS
 WPR      EQU    5           WRONG PROGRAM
 IBF      EQU    6           INSUFFICIENT BUFFER
 ILE      EQU    10          ILLEGAL LIBRARY ENTRY
 IDS      EQU    20          INSUFFICIENT DIRECTORY SPACE
 
 FERT     EQU    40          FATAL ERROR TYPES.
 
 ARG      EQU    40          ARGUMENT ERROR (MUST ALWAYS BE FATAL)
 IOS      EQU    41          I/O SEQUENCE ERROR (MUST ALWAYS BE FATAL)
 MSR      EQU    42          MASS STORAGE ERROR (MUST ALWAYS BE FATAL)
          QUAL   *
 
 MEPO     EQU    1           MASS STORAGE ERROR PROCESSING OPTION
 RSLM     EQU    1000        RECALL SECTOR LIMIT
 
****
          SPACE  4,10
***       COMMON DECKS.
 
 
*CALL     COMPMAC
*CALL     COMSCPS
*CALL     COMSMSP
*CALL     COMSPIM
*CALL     COMSSRU
          SPACE  4,25
****      DIRECT LOCATION ASSIGNMENTS.
 
 
 ER       EQU    17          EOR FLAG
 FS       EQU    20 - 24     FST ENTRY
 CC       EQU    25          CAPSULE COUNT
 GO       EQU    26          GROUP ORDINAL
 CL       EQU    27          LENGTH OF CENTRAL MEMORY DIRECTORY
 GN       EQU    30 - 34     GROUP NAME
 AB       EQU    30 - 34     NAME TO SEARCH FOR IN *CLD*
 UL       EQU    35 - 36     USER SPECIFIED FILE LIST ADDRESS
 DI       EQU    37          ACTUAL DIRECTORY LENGTH
 FN       EQU    40 - 44     FNT ENTRY
 FW       EQU    45 - 46     FWA OF CM BUFFER
 TI       EQU    45 - 46     LIBRARY BASE RANDOM INDEX
 EC       EQU    47          ERROR CODE
 FA       EQU    57          RELATIVE FNT ADDRESS IN NFL
 BL       EQU    60          BUFFER LIMIT ADDRESS
 SI       EQU    61 - 62     SRU INCREMENT TO ERROR PROCESSOR
 RI       EQU    63 - 64     RANDOM INDEX
 BS       EQU    65 - 66     BUFFER SIZE (CM BUFFER)
 DA       EQU    65 - 66     DIRECTORY BASE ADDRESS
 DL       EQU    67          USER SPECIFIED DIRECTORY LENGTH
 
****
          TITLE  MACRO DEFINITIONS.
          SPACE  4,10
**        MACRO DEFINITIONS.
 COMMON   SPACE  4,10
**        COMMON - COMMON CODE FOR *LDD* AND *LDQ*.
*
*         THIS MACRO PROVIDES IDENTICAL CODE FOR *LDD* AND *LDQ*.
 
 
 COMMON   MACRO
 CIS      SPACE  4,10
**        CIS - CLEAR INTERLOCKS.
*
*         ENTRY  (CISA) = TRACK NUMBER IF INTERLOCK SET.
*
*         EXIT   (CISA) = 0.
*
*         CALLS  CTI.
 
 
 CIS      SUBR               ENTRY/EXIT
          LDC    0
 CISA     EQU    *-1
          ZJN    CISX        IF NO INTERLOCK SET
          RJM    CTI
*         LDN    0           CLEAR INTERLOCK SET STATUS
          STM    CISA
          UJN    CISX        RETURN
 MSR      SPACE  4,15
**        MSR - MASS STORAGE ERROR PROCESSING.
*
*         ENTRY  (A) = STATUS RETURNED FROM AN I/O ERROR.
*                (T5) = EST ORDINAL.
*                (FA) = FNT ADDRESS IF LOCAL FILE PRESENT.
*                     = 0, OTHERWISE.
*
*         USES   FS+4, IR+4.
*
*         CALLS  CIS.
*
*         MACROS ERROR, EXECUTE.
 
 
 MSR      CON    0           ENTRY
          SHN    21-12
          MJN    MSR2        IF UNRECOVERABLE ERROR
          LDM    MSD
          SHN    21-13
          MJN    MSR3        IF NOT SUBSYSTEM
 MSR2     RJM    CIS
          ERROR  MSR         * DEVICE ERROR.*
 
*         CALL *1RJ* TO RECALL THE PP AND ROLL THE JOB.
 
 MSR3     LDD    T5          EST ORDINAL
          STD    IR+4
          RJM    CIS         CLEAR INTERLOCKS
          AOD    FS+4        SET FET NOT BUSY
          LDD    FA
          ZJN    MSR4        IF NO LOCAL FNT
          NFA    FA,R
          ADN    FSTL
          CWD    FS
 MSR4     EXECUTE  1RJ
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPCTI
*CALL     COMPRNS
          ENDM
 ERROR    SPACE  4,15
**        ERROR - SET ERROR STATUS.
*
*
*NAME     ERROR  CODE
*
*         ENTRY  *NAME* = OPTIONAL LOCATION TAG.
*                *CODE* = ERROR CODE.
 
          PURGMAC ERROR
 
 ERROR    MACRO  A
          MACREF ERROR
          LDN    /ERR/A
          RJM    ERR
          ENDM
 LDCA     SPACE  4,20
**        LDCA - LOAD ABSOLUTE CM ADDRESS.
*
*
*NAME     LDCA    DC
*
*         ENTRY  *NAME* = OPTIONAL LOCATION TAG.
*                *DC* = FIRST OF TWO DIRECT LOCATIONS TO BE USED.
 
          PURGMAC LDCA
 
 LDCA     MACRO  X
          MACREF LDCA
          LDD    X
          LPN    37
          SHN    6
          ADD    RA
          SHN    6
          ADD    X+1
          ENDM
 MSG      SPACE  4,15
**        MSG - DEFINE MESSAGE.
*
*ERR      MSG    (TEXT)
*
*         ENTRY  *ERR* = ERROR CODE.
*                *TEXT* = ERROR MESSAGE.
 
          PURGMAC MSG
 
          MACRO  MSG,ERR,TEXT
          LOCAL  A
          MACREF MSG
 A        MICRO  1,,$TEXT$
 A        MICCNT A
          ERRNG  20D-A       MESSAGE TOO LONG
 ERR      CON    =Z$TEXT$
          ENDM
 LDD      TITLE  MAIN PROGRAM.
          QUAL   LDD
 
***       LDD - MAIN PROGRAM.
 
 
          ORG    PPFW
 
 LDD      RJM    PRS         PRESET
 LDDB     LDN    0
*         LDN    1           (FUNCTION CODE 402)
          NJN    LDD3.4      IF FUNCTION CODE IS 402
          LDD    CP          READ GLOBAL LIBRARY SET
          ADC    LB1W
          CRM    TLBD,TR
 LDD1     LDN    0           CLEAR FNT ADDRESS
          STD    FA
          STD    FN          CLEAR FILE NAME
          STM    SISA
          PAUSE
          LDD    CM+1        CHECK ERROR FLAGS
          ZJN    LDD3        IF NO ERROR FLAGS
 LDD2     LJM    SCS         SET COMPLETE STATUS
 
 LDD3     RJM    CRP         CHECK RECALL PARAMETERS
          RJM    GNL         GET NEXT LIBRARY
          LDD    FN          CHECK LIBRARY FOUND
          NJN    LDD5        IF NOT END OF LIBRARIES
 LDDA     LDN    0
*         LDN    1           (FUNCTION CODE 404)
          ZJN    LDD2        IF NOT FUNCTION CODE 404
 LDD3.4   RJM    SCP         SEARCH *CLD* FOR PROCEDURE RECORD
          NJN    LDD4        IF ENTRY FOUND
          ERROR  ILE         ILLEGAL LIBRARY ENTRY
          UJN    LDD2        EXIT
 
 LDD4     RJM    PDE         PROCESS DIRECTORY ENTRY
          UJN    LDD2        SET COMPLETE STATUS
 
 LDD5     RJM    LNL         LOCATE NEXT LIBRARY
          LDD    FN          CHECK LIBRARY FOUND
          ZJN    LDD6        IF LIBRARY NOT FOUND
 
*         PROCESS *ULIB* RECORD.
 
          LDC    BUF         LOAD BUFFER MEMORY
          RJM    LBM
          LDC    BUF         RESET BUFFER ADDRESS
          STD    T3
          RJM    VUT         VALIDATE *ULIB* TABLES
          NJN    LDD7        IF NO ERROR IN *ULIB* TABLES
 
 LDD6     ERROR  ILE         ILLEGAL LIBRARY ENTRY
          RJM    CIS         CLEAR INTERLOCK STATUS
          UJN    LDD8
 
 LDD7     RJM    SFG         SEARCH FOR GROUP NAME
          ZJN    LDD6        IF NO MATCH ON GROUP NAME
 
*         PROCESS *OPLD* RECORD.
 
          RJM    SIS         SET INTERLOCK STATUS
          LDD    FS+1        SET FIRST TRACK
          STD    T6
          RJM    CRA         CONVERT RANDOM ADDRESS
          MJN    LDD6        IF RANDOM INDEX ERROR
          LDC    BUF         LOAD BUFFER MEMORY
          RJM    LBM
          LDC    BUF         RESET BUFFER ADDRESS
          STD    T3
          RJM    VOT         VALIDATE *OPLD* TABLE
          MJN    LDD6        IF ERROR IN *OPLD* TABLE
          RJM    PGM         PROCESS GROUP MEMBERS
          ZJN    LDD8        IF NO FIND OR CAPSULE PROCESSING
          LJM    LDD2        IF FIND ON FUNCTION CODE 404
 
 LDD8     AOD    FS+4        SET FILE NOT BUSY
          LDD    FA
          ZJN    LDD9        IF NOT LOCAL LIBRARY
          NFA    FA,R
          ADN    FSTL
          CWD    FS
 LDD9     LJM    LDD1        LOOP
          TITLE  LIBRARY MANIPULATION ROUTINES.
 GNL      SPACE  4,15
***       GNL - GET NEXT LIBRARY NAME.
*
*         ENTRY  (UL - UL+1) = ADDRESS OF NEXT USER LIBLIST ENTRY.
*                (TLBD) = GLOBAL LIBRARY SET.
*                (FN) = 0.
*
*         EXIT   (FN) = 0 IF NO LIBRARY FOUND.
*                (FN - FN+4) = NAME OF NEXT USER LIBRARY.
*                (UL - UL+1) = UPDATED TO NEXT USER LIBLIST ENTRY.
*                TO *ERR* IF ILLEGAL LIBLIST ADDRESS.
*
*         USES   T7, CM - CM+4, FN - FN+4, UL - UL+1.
 
 
*         PROCESS USER LIBLIST ENTRY.
 
 GNL4     LDD    UL          CHECK USER SPECIFIED LIBLIST
          SHN    14
          ADD    UL+1
          ZJN    GNLX        IF NO USER SPECIFIED LIBLIST
          SHN    -6          CHECK USER LIBLIST ADDRESS
          SBD    FL
          MJN    GNL6        IF LIBLIST ADDRESS WITHIN FL
 GNL5     ERROR  ILA         ILLEGAL LIBLIST ADDRESS
 
 GNL6     LDCA   UL          READ LIBRARY NAME
          CRD    FN
          AOD    UL+1        ADVANCE LIBLIST ADDRESS
          SHN    -14
          RAD    UL
 GNL7     LDD    FN+3        SET LIBRARY NAME
          SCN    77
          STD    FN+3
          LDN    0
          STD    FN+4
 
 GNL      SUBR               ENTRY/EXIT
          LDC    TLBD+3      CHECK END OF GLOBAL LIBRARY SET TABLE
 GNLA     EQU    *-1
          STD    T7
          LMC    TLBDL
 GNLB     EQU    *-1
*         LMC    TLBDL-5     (ONE LOCAL USER LIBRARY)
*         LMC    TLBDL-12    (TWO LOCAL USER LIBRARIES)
          ZJN    GNL1        IF END OF GLOBAL LIBRARY SET
          LDI    T7          GET NEXT LIBRARY ORDINAL
 GNLC     SHN    -6          POSITION ORDINAL
*         SHN    0           (LIBRARY ORDINAL IN LOWER SIX BITS)
          LPN    77
          NJN    GNL2        IF NOT END OF GLOBAL LIBRARY SET
 GNL1     LJM    GNL4
 
 GNL2     STD    T7
          AOM    GNLE        ADVANCE GLOBAL LIBRARY INDEX
          SHN    -1
          ADC    TLBD+3
          STM    GNLA
          LDM    GNLC        ADVANCE SHIFT INSTRUCTION
          LMN    -6+77
          STM    GNLC
          LDD    T7
          SBN    77
          ZJN    GNL3        IF LOCAL USER LIBRARY
          ADN    76          SET OFFSET = (ORDINAL-1) * 2
          SHN    1
          STD    T7
          LDC    LBDP        READ LIBRARY DIRECTORY
          CRD    CM
          LDD    CM+2        FORM ADDRESS OF LIBRARY NAME
          SHN    14
          ADD    CM+3
          ADD    T7          ADD OFFSET
          CRD    FN          READ LIBRARY NAME
          LJM    GNL7
 
*         READ LOCAL FILE LIBRARY NAME.
 
 GNL3     LDD    CP          READ LOCAL USER LIBRARY NAME
          ADC    LB3W
 GNLD     EQU    *-1
*         ADC    LB2W        (SECOND LOCAL USER LIBRARY)
          CRD    FN          READ LIBRARY NAME
          SOM    GNLD        ADVANCE LOCAL USER LIBRARY POINTER
          LCN    5           ADVANCE END OF GLOBAL LIBRARY SET TABLE
          RAM    GNLB
          AOM    CRPA        ADVANCE RECALL VALUE
          LJM    GNL7
 
 GNLE     CON    0           GLOBAL LIBRARY SET BYTE INDEX
 LNL      SPACE  4,25
***       LNL - LOCATE NEXT LIBRARY.
*
*         ENTRY  (FN - FN+3) = LIBRARY NAME.
*                (LNLA) = FNT ADDRESS SYSTEM FILE.
*
*         EXIT   (FN) = 0 IF LIBRARY NOT FOUND.
*                (T5) = EQUIPMENT.
*                (T6) = FIRST TRACK OF LIBRARY FILE.
*                (FA) = FNT ADDRESS IF LOCAL FILE LIBRARY FOUND.
*                (PDEB) = INDEX OF LIBRARY FILE HEADER IN DIRECTORY.
*                (RI - RI+1) = RANDOM INDEX OF LIBRARY *ULIB* RECORD.
*                (FS - FS+4) = FST OF LOCAL FILE USER LIBRARY.
*                (DIRA - DIRA+4) = FIRST WORD OF DIRECTORY ENTRY FOR
*                                  LIBRARY.
*                (CISA) = SET TO INDICATE INTERLOCK CLEARED.
*                (SISA) = SET TO INDICATE IF INTERLOCK REQUIRED.
*                RANDOM ACCESS PROCESSORS PRESET.
*                DRIVER LOADED AND ERROR PROCESSING SET.
*
*         USES   FA, CM - CM+4, FN - FN+4, FS - FS+4, RI - RI+4,
*                T1 - T7.
*
*         CALLS  CRA, IRA, SAF, SFB, SIS.
*
*         MACROS ERROR, SETMS, SFA.
 
 
 LNL      SUBR               ENTRY/EXIT
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          NJN    LNL1        IF FILE FOUND
          LJM    LNL5        SEARCH SYSTEM LIBRARIES
 
 LNL1     RJM    SFB         SET FILE BUSY
          ZJN    LNL2        IF FILE SET BUSY
          ERROR  IOS         * I/O SEQUENCE ERROR.*
 
 LNL2     LDD    CM+3        CHECK FILE MODE
          LPN    4
          ZJN    LNL2.1      IF NOT EXECUTE-ONLY
          LDD    CP          CHECK VALID ACCESS
          ADC    EOCW
          CRD    T1
          LDD    T1
          LMD    FA
          NJN    LNL4        IF NOT VALID ACCESS
 LNL2.1   LDD    CM+4        CHECK FILE TYPE
          SHN    -6
          LMN    PMFT
          NJN    LNL3        IF NO PERMANENT FILE
          LDD    CM+3        CHECK ACCESS MODE
          LPN    20
          ZJN    LNL3        IF NOT M, A, RM, OR RA MODE
          LDD    FS+1
          STM    SISA        SET INTERLOCK REQUIRED STATUS
 LNL3     LDD    FS
          STD    T5
          SFA    EST         READ EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    CM          CHECK EQUIPMENT TYPE
          SHN    21-13
          PJN    LNL4        IF NOT MASS STORAGE
          LDD    FS+2        CHECK FOR TRACK
          ZJN    LNL4        IF FILE EMPTY
          LJM    LNL10       PROCESS LOCAL FILE
 
*         SET ERROR STATUS.
 
 LNL4     LDN    0           CLEAR FIRST BYTE OF LIBRARY NAME
          STD    FN
          LJM    LNLX        RETURN
 
*         SEARCH LIBRARY NAME TABLE FOR LIBRARY.
 
 LNL5     STD    T5          CLEAR LIBRARY ORDINAL
          LDC    LBDP        READ LIBRARY NAME TABLE FWA
          CRD    CM-1
 LNL6     AOD    T5          ADVANCE ORDINAL
          LDD    CM+1        READ LIBRARY NAME
          SHN    14
          ADD    CM+2
          CRD    FS
          ADN    1           READ RANDOM ADDRESS
          CRD    RI-3
          LDD    FS          COMPARE CHARACTERS 1 AND 2
          ZJN    LNL4        IF END OF LIBRARY NAME TABLE
          LMD    FN
          ZJN    LNL8        IF CHARACTERS MATCH
 LNL7     LDN    2           ADVANCE LIBRARY NAME TABLE ADDRESS
          RAD    CM+2
          SHN    -14
          RAD    CM+1
          UJN    LNL6        LOOP TO END OF LIBRARY NAME TABLE
 
 LNL8     LDD    FN+1        COMPARE CHARACTERS 3 AND 4
          LMD    FS+1
          NJN    LNL7        IF NO COMPARE
          LDD    FN+2        COMPARE CHARACTERS 5 AND 6
          LMD    FS+2
          NJN    LNL7        IF NO COMPARE
          LDD    FN+3        COMPARE CHARACTER 7
          LMD    FS+3
          SCN    77
          NJN    LNL7        IF NO COMPARE
 
*         FORM SYSTEM LIBRARY DIRECTORY HEADER.
 
          LDN    ZERL        CLEAR DIRECTORY ENTRY
          CRM    DIRA,ON
          LDD    DI          SET INDEX TO FILE ENTRY
          STM    PDEB
          LDD    T5          ADD LIBRARY ORDINAL
          SHN    6
          STM    DIRA+3
          LCN    0
          STM    DIRA
          LDN    FNTP        READ SYSTEM FST ENTRY
          CRD    CM
          LDD    CM
          SHN    14
          LMD    CM+1
          ERRNZ  SYFO        SYSTEM FILE ORDINAL .NE. 0
          ADN    FSTG
          CRD    FS
          CRD    T5
          LDD    RI          SET RANDOM ADDRESS BIAS
          SHN    14
          ADD    RI+1
          SBN    1
          STD    TI+1
          SHN    -14
          STD    TI
          RJM    IRA         INITIALIZE RANDOM ACCESS PROCESSORS
          RJM    CRA         CONVERT RANDOM ADDRESS
          PJN    LNL9        IF NO RANDOM INDEX ERROR
          LJM    LNL4
 
 LNL9     SETMS  READSYS     SYSTEM SELECTION OF EQUIPMENT
          LJM    LNLX        RETURN
 
*         FORM LOCAL LIBRARY DIRECTORY HEADER.
 
 LNL10    LDD    FS+1        SET FIRST TRACK
          STD    T6
          LDN    0           SET INITIAL RANDOM ADDRESS
          STD    RI
          STD    TI
          LDN    FSMS
          STD    RI+1
          SBN    1           SET RANDOM ADDRESS BIAS
          STD    TI+1
          LDD    MA          FORM FIRST WORD OF DIRECTORY
          CWD    FN
          CRM    DIRA,ON
          LDC    4000        FLAG FILE DIRECTORY ENTRY
          RAM    DIRA
          LDD    DI          SET INDEX TO FILE ENTRY
          STM    PDEB
          RJM    IRA         INITIALIZE RANDOM ACCESS PROCESSORS
          RJM    SIS         SET INTERLOCK STATUS
          RJM    CRA
          PJN    LNL11       IF NO RANDOM INDEX ERROR
          LJM    LNL4
 
 LNL11    SETMS  IO
          LJM    LNLX        RETURN
 PGM      SPACE  4,15
***       PGM - PROCESS GROUP MEMBERS.
*
*         ENTRY  (GO) = ORDINAL OF GROUP NAME WITHIN CURRENT LIBRARY.
*                (T2) = *OPLD* TABLE BASE ADDRESS.
*                (BL) = BUFFER LIMIT ADDRESS.
*                (ER) = BUFFER EOR/EOF/EOI STATUS.
*                (GN - GN+4) = NAME OF *CCL* PROCEDURE TO LOCATE
*                IF FUNCTION CODE 404.
*
*         EXIT   ALL CAPSULES OR PROCEDURE RECORDS PROCESSED.
*                (A) = 1 IF FIND ON FUNCTION CODE 404.
*                (A) = 0 IF NO FIND ON FUNCTION CODE 404 OR *EOR*
*                STATUS REACHED FOR PROCESSING OF CAPSULES.
*                TO *SCS* IF ERROR FLAG SET.
*
*         USES   T1, T2, T3.
*
*         CALLS  LBM, PDE, SIS.
 
 
 PGM      SUBR               ENTRY/EXIT
          LDD    T2          SKIP *OPLD* TABLE
          ADN    1*5
 PGM1     STD    T3          SET BASE ADDRESS
 PGM2     LDN    0
*         LDN    1           (FUNCTION CODE 404)
 PGMA     EQU    *-1
          ZJN    PGM5        IF NOT FUNCTION CODE 404
          LDM    4,T3        CHECK FOR TYPE *PROC*
          LMN    20
          ZJN    PGM3        IF TYPE *PROC*
          LJM    PGM6        IF NOT TYPE *PROC*
 
 PGM3     LDD    T3
          STD    T1
          LDN    GN          CHECK NAME FOR MATCH
          STD    T2
 PGM4     LDI    T2
          LMI    T1
          NJN    PGM6        IF NO MATCH
          AOD    T1
          AOD    T2
          LMN    GN+3
          NJN    PGM4        IF 3 BYTES NOT PROCESSED
          LDI    T2          CHECK FOURTH BYTE
          LMI    T1
          SCN    77
          NJN    PGM6        IF NO MATCH
          RJM    PDE         PROCESS DIRECTORY ENTRY
          LDN    1
          LJM    PGMX        RETURN
 
 PGM5     LDM    4,T3        CHECK FOR TYPE *CAP*
          LMN    16
          NJN    PGM6        IF NOT TYPE *CAP*
          LDM    5,T3        CHECK GROUP ORDINAL
          LMD    GO
          NJN    PGM6        IF NOT CORRECT GROUP ORDINAL
          RJM    PDE         PROCESS DIRECTORY ENTRY
 PGM6     LDN    2*5         INCREMENT BASE ADDRESS
          RAD    T3
          SBD    BL          CHECK BUFFER LIMIT
          PJN    PGM7        IF BUFFER EXHAUSTED
          LJM    PGM2        LOOP
 
 PGM7     LDD    ER          CHECK EOR STATUS
          NJN    PGM8        IF NOT *EOR* IN BUFFER
          LJM    PGMX        IF *EOR* IN BUFFER
 
 PGM8     RJM    SIS         SET INTERLOCK STATUS
          LDC    BUF         RELOAD BUFFER
          RJM    LBM         LOAD BUFFER MEMORY
          LDC    BUF+2       RESET BASE ADDRESS
          LJM    PGM1        LOOP
 SFG      SPACE  4,20
***       SFG - SEARCH FOR GROUP MEMBERS.
*
*         ENTRY  (A) = NUMBER OF GROUP NAMES IN *ULIB* RECORD.
*                (T2) = *ULIB* TABLE BASE ADDRESS.
*                (TI - TI+1) = BASE RANDOM ADDESS OF LIBRARY.
*                (GN - GN+4) = GROUP NAME.
*                (BL) = BUFFER LIMIT ADDRESS.
*                (ER) = BUFFER EOR/EOF/EOI STATUS.
*
*         EXIT   (A) = 0 IF NO GROUP NAMES FOUND.
*                (A) .NE. 0 IF GROUP NAME FOUND WITHIN *ULIB* RECORD.
*                (A) = 1 IF FUNCTION CODE 404.
*                (CC) = NUMBER OF CAPSULES IN CURRENT GROUP.
*                (GO) = ORDINAL OF GROUP WITHIN CURRENT LIBRARY.
*                (RI - RI+1) = RANDOM INDEX OF LIBRARY *OPLD* RECORD.
*                TO *SCS* IF ERROR FLAG SET.
*
*         USES   T3, CC, GO, RI - RI+1.
*
*         CALLS  LBM, SIS.
 
 
 SFG      SUBR               ENTRY/EXIT
          STD    CC          SAVE GROUP COUNT
          LDM    3,T2        SET *OPLD* RANDOM ADDRESS
          ADD    TI+1
          STD    RI+1
          SHN    -14
          ADM    2,T2
          ADD    TI
          STD    RI
 SFGA     LDN    0
*         LDN    1           (FUNCTION CODE 404)
          NJN    SFGX        IF FUNCTION CODE 404
          LDN    1           INITIALIZE GROUP NAME ORDINAL
          STD    GO
          LDD    T2          SKIP *ULIB* HEADER
          ADN    5
 SFG1     STD    T3          SET BASE ADDRESS
 SFG2     LDD    GN          CHECK GROUP NAME
          LMI    T3
          LPC    3777
          ZJN    SFG4        IF MATCH
 SFG3     SOD    CC          DECREMENT GROUP COUNT
          ZJN    SFGX        IF ALL GROUPS PROCESSED
          AOD    GO          INCREMENT GROUP ORDINAL
          LDN    5           ADVANCE TO NEXT ITEM
          RAD    T3
          SBD    BL          CHECK BUFFER LIMIT
          PJN    SFG5        IF BUFFER EXHAUSTED
          UJN    SFG2        LOOP
 
 SFG4     LDD    GN+1        COMPARE NAME CHARACTERS 3 AND 4
          LMM    1,T3
          NJN    SFG3        IF NO MATCH
          LDD    GN+2        COMPARE NAME CHARACTERS 5 AND 6
          LMM    2,T3
          NJN    SFG3        IF NO MATCH
          LDD    GN+3        COMPARE NAME CHARACTER 7
          LMM    3,T3
          SCN    77
          NJN    SFG3        IF NO MATCH
          LDM    4,T3        SET CAPSULE COUNT
          STD    CC
          LJM    SFGX        RETURN
 
 SFG5     LDD    ER          CHECK EOR STATUS
          NJN    SFG6        IF EOR NOT IN BUFFER
          LJM    SFGX        RETURN, SET NAME NOT FOUND
 
 SFG6     RJM    SIS         SET INTERLOCK STATUS
          LDC    BUF         RELOAD BUFFER
          RJM    LBM         LOAD BUFFER MEMORY
          LDC    BUF+2       RESET BASE ADDRESS
          LJM    SFG1        LOOP
          TITLE  SUBROUTINES.
          SPACE  4,10
**        COMMON SUBROUTINES.
 
 
          COMMON
 CRP      SPACE  4,10
**        CRP - CHECK RECALL PARAMETERS.
*
*         ENTRY  (DPPB - DPPB+1) = CURRENT ACCUMULATOR UPDATE.
*
*         USES   CM - CM+4, GN+3 - GN+4.
*
*         CALLS  DPP.
*
*         MACROS LDCA, MONITOR.
 
 
 CRP      SUBR               ENTRY/EXIT
          LDM    DPPC        CHECK TIME TO RECALL
          ADC    -RSLM
          MJN    CRPX        IF NOT TIME TO RECALL
 
*         SET RECALL PARAMETERS.
 
          LDM    GNLE
          SHN    -1
          STD    CM
 CRPA     LDN    0           SET NUMBER OF LOCAL USER LIBRARIES
          SHN    4
          LMD    CM
          SHN    6
          LMN    40          SET RECALL BIT
          RAD    IR+3
          LDD    DI          SET DIRECTORY INDEX
          STD    IR+2
          LDM    GNLC        SET LIBRARY ORDINAL POSITION
          LPN    1
          LMN    1
          STD    GN+4
          LDM    SCSA        SET EXISTING ERROR CODE
          SHN    11
          RAD    GN+4
          SHN    -14
          RAD    GN+3
          LDCA   IR+3        REWRITE PARAMETER BLOCK
          CWD    GN
          LDN    1           SELECT NO DROP PP
          RJM    DPP         UPDATE ACCOUNTING
          LDN    ZERL
          CRD    CM
          LDN    PTLR        PRU TRANSFER LIMIT
          STD    CM
          LDD    MA          STORE PP RECALL REQUEST
          CWD    IR
          ADN    1
          CWD    CM
          MONITOR  RECM
          LJM    PPR         EXIT TO PP RESIDENT
 DPP      SPACE  4,10
**        DPP - DROP PPU.
*
*         ENTRY  (A) = 0 IF PP TO BE DROPPED.
*                (FA) = FNT ADDRESS.
*                (FS - FS+4) = FST INFORMATION.
*                (DPPB - DPPB+1) = MASS STORAGE ACCOUNTING INCREMENT.
*
*         EXIT   ACCOUNTING UPDATED.
*                FST SET NOT BUSY.
*                PP DROPPED IF SELECTED.
*
*         USES   CM - CM+4.
*
*         MACROS MONITOR, NFA.
 
 
 DPP      SUBR               ENTRY/EXIT
          STD    CM+2        SET PP DROP / NO DROP OPTION
          LDD    FA
          ZJN    DPP1        IF NO LOCAL FNT
          AOD    FS+4
          NFA    FA,R        SET FST NOT BUSY
          ADN    FSTL
          CWD    FS
 DPP1     LDD    MA          COPY PARAMETER WORD TO MESSAGE BUFFER
          CWM    DPPA,ON
          LDN    1           SET WORD COUNT
          STD    CM+1
          MONITOR UADM
          UJN    DPPX        RETURN
 
 DPPA     CON    AISS        SUB FUNCTION
          CON    IOAW        WORD TO UPDATE
          CON    40D*100+20D FIELD TO UPDATE
 DPPB     CON    0,0         INCREMENT
 DPPC     DATA   0           PRU COUNTER
 ERR      SPACE  4,15
**        ERR - ERROR PROCESSOR.
*
*         ENTRY  (A) = ERROR CODE.
*
*         EXIT   RETURN IF CONTINUATION ERROR. (MULTIPLE ERROR CODES)
*                SET ERROR CODE AND DROP IF NON-FATAL ERROR.
*                EXECUTE *2LD* IF FATAL ERROR.
*
*         USES   EC, SI - SI+1.
*
*         CALLS  SCS, 2LD.
*
*         MACROS EXECUTE.
 
 
 ERR      SUBR               ENTRY/EXIT
          STD    EC          STORE ERROR CODE
          SBN    /ERR/FERT   CHECK FOR FATAL ERROR
          MJN    ERR1        IF NOT FATAL ERROR
          LDM    DPPB        SET MASS STORAGE INCREMENT
          STD    SI
          LDM    DPPB+1
          STD    SI+1
          EXECUTE 2LD
 
 ERR1     LCN    0           SET ERROR CODE BITS IN RESPONSE
          LMD    EC
          STM    ERRA
          LDM    SCSA
          LPC    *
 ERRA     EQU    *-1
          LMD    EC
          STM    SCSA
          LDD    EC          CHECK FOR CONTINUATION
          LMN    /ERR/ILE
          ZJN    ERRX        IF CONTINUATION ERROR
          LMN    /ERR/IDS&/ERR/ILE
          ZJN    ERRX        IF CONTINUATION ERROR
          LJM    SCS         SET COMPLETE STATUS
 IBA      SPACE  4,15
**        IBA - INCREMENT BUFFER ADDRESS.
*
*         ENTRY  (T3) = BUFFER ADDRESS.
*                (IBAA - IBAA+1) = DATA SAVED FROM LAST SECTOR.
*
*         EXIT   (A) .GE. 0 IF BUFFER FULL.
*                (T3) = NEW BUFFER ADDRESS.
*                (BL) = BUFFER LIMIT ADDRESS.
*                (IBAA - IBAA+1) = DATA SAVED FROM CURRENT SECTOR.
*                PREVIOUS DATA RESTORED OVER LINKAGE BYTES.
*
*         USES   T3.
 
 
 IBA1     LDI    T3          SAVE DATA AREA
          STM    IBAA
          LDM    1,T3
          STM    IBAA+1
          LCN    1           SET EXIT CONDITION
 
 IBA      SUBR               ENTRY/EXIT
          LDM    IBAA        RESTORE PREVIOUS DATA
          STI    T3
          LDM    IBAA+1
          STM    1,T3
          LDC    100*5       INCREMENT BUFFER ADDRESS
          RAD    T3
          ADC    -BFMS       CHECK BUFFER FULL
          MJN    IBA1        IF BUFFER NOT FULL
          UJN    IBAX        EXIT
 
 
 IBAA     CON    0,0         DATA SAVE AREA
 LBM      SPACE  4,15
**        LBM - LOAD BUFFER MEMORY.
*
*         ENTRY  (A) = ADDRESS OF START OF BUFFER.
*
*         EXIT   (BL) = BUFFER LIMIT ADDRESS.
*                (ER) = BUFFER EOR/EOF/EOI STATUS.
*                (DPPB - DPPB+1) = SRU ACCUMULATOR INCREMENTED.
*                BUFFER FILLED OR EOR/EOF/EOI ENCOUNTERED.
*                CHANNEL DROPPED.
*                TRACK INTERLOCK CLEARED, IF SET.
*                TO *SCS* IF ERROR FLAG SET.
*
*         USES   T3, BL, ER, DPPB - DPPB+1.
*
*         CALLS  CIS, IBA, RNS, SCS.
*
*         MACROS ENDMS, PAUSE.
 
 
 LBM      SUBR               ENTRY/EXIT
          STD    T3          SET BUFFER FWA
          ADN    2           SET INITIAL BUFFER LIMIT
          STD    BL
          UJN    LBM2
 
 LBM1     RJM    IBA         INCREMENT BUFFER ADDRESS
          PJN    LBM4        IF BUFFER FULL
 LBM2     LDN    IMLL        INCREMENT MASS STORAGE ACCUMULATOR
          RAM    DPPB+1
          SHN    -14
          RAM    DPPB
          AOM    DPPC
          LDD    T3          READ NEXT SECTOR
          RJM    RNS
          SHN    2           ADJUST BUFFER LIMIT ADDRESS
          ADD    T1
          RAD    BL
          LDD    T1          SET EOR/EOF/EOI STATUS
          SHN    -6
          STD    ER
          NJN    LBM1        IF NOT EOR/EOF/EOI
 
 LBM3     LDM    IBAA        RESTORE BASHED DATA
          STI    T3
          LDM    IBAA+1
          STM    1,T3
 LBM4     ENDMS
          RJM    CIS         CLEAR INTERLOCK STATUS
          PAUSE
          LDD    CM+1        CHECK ERROR FLAG
          ZJN    LBM5        IF ERROR FLAG NOT SET
          LJM    SCS         SET COMPLETE STATUS
 
 LBM5     LJM    LBMX        RETURN
 PDE      SPACE  4,25
**        PDE - PROCESS DIRECTORY ENTRY.
*
*         ENTRY  (T3) = ADDRESS OF DIRECTORY ENTRY.
*                (CL) = LENGTH OF CENTRAL MEMORY DIRECTORY.
*                (DI) = CURRENT LENGTH REQUIRED FOR DIRECTORY.
*                (DL) = USER SPECIFIED DIRECTORY LENGTH.
*                (TI - TI+1) = BASE RANDOM ADDESS OF LIBRARY.
*                (PDEB) = INDEX TO LIBRARY FILE HEADER IN DIRECTORY.
*                (DIRA - DIRA+4) = FIRST WORD OF DIRECTORY ENTRY.
*
*         EXIT   IF ENTRY FOUND IN DIRECTORY.
*                  NO CHANGE.
*                IF ENTRY NOT FOUND AND NO DIRECTORY OVERFLOW.
*                  (CL) UPDATED TO REFLECT ENTRY LENGTH.
*                  (DI) UPDATED TO REFLECT ACTUAL DIRECTORY LENGTH.
*                  ENTRY WRITTEN TO DIRECTORY.
*                IF ENTRY NOT FOUND AND DIRECTORY OVERFLOW.
*                  (DI) UPDATED TO REFLECT ACTUAL DIRECTORY LENGTH.
*                  ERROR CODE *IDS* SET IN RESPONSE.
*
*         USES   T1, T3, CL, DI, DL.
*
*         CALLS  SFE.
 
 
*         PROCESS DIRECTORY OVERFLOW.
 
 PDE6     LDD    T1          ADVANCE ACTUAL DIRECTORY SPACE REQUIRED
          RAD    DI
          LDM    DIRA        CHECK IF FILE HEADER PRESENT
          ZJN    PDEX        IF NO FILE HEADER
          LDN    0           CLEAR FILE HEADER
          STM    DIRA
 
 PDE      SUBR               ENTRY/EXIT
          LDD    CL
          ZJN    PDE1        IF CENTRAL DIRECTORY EMPTY
          RJM    SFE         SEARCH FOR DUPLICATE ENTRY
          ZJN    PDEX        IF ENTRY FOUND
 PDE1     LDN    2           SET DIRECTORY ENTRY LENGTH
          STD    T1
          LDM    DIRA
          ZJN    PDE2        IF NO FILE HEADER REQUIRED
          AOD    T1
 PDE2     LDD    DL
 PDEA     EQU    *-1
*PDE2     UJN    PDE6        (DIRECTORY OVERFLOW)
          SBD    CL
          SBD    T1
          PJN    PDE3        IF WITHIN DIRECTORY
          LDM    PDED
          STM    PDEA
          ERROR  IDS         INSUFFICIENT DIRECTORY SPACE
          LJM    PDE6        UPDATE REQUIRED DIRECTORY LENGTH
 
 PDE3     LDD    T1          ADVANCE CENTRAL MEMORY DIRECTORY LENGTH
          RAD    CL
          LDD    T3          SET CAPSULE NAME ADDRESS
          STM    PDEC
          LDC    *           SET FILE INDEX
 PDEB     EQU    *-1
          STM    4,T3
          LDM    7,T3        SET ENTRY LENGTH
          SHN    -6
          STM    DIRB+4
          LDM    6,T3
          SHN    6
          RAM    DIRB+4
          SHN    -14
          STM    DIRB+3
          LDD    TI+1        SET RANDOM ADDRESS OF CAPSULE
          ADM    11,T3
          SHN    14
          STM    DIRB+2      SAVE UPPER 12 BITS
          SHN    -6
          SCN    77
          RAM    DIRB+3
          LDD    TI
          ADM    10,T3
          SHN    6
          RAM    DIRB+2
          LDN    0           SET CORE ADDRESS
          STM    DIRB+1
          LDC    4000
          STM    DIRB
          LDM    DIRA        CHECK TWO OR THREE WORD ENTRY
          ZJN    PDE4        IF TWO WORD ENTRY
 
*         WRITE THREE WORD DIRECTORY ENTRY.
 
          LDCA   DA          WRITE HEADER WORD TO DIRECTORY
          ADD    DI          ADD INDEX
          CWM    DIRA,ON     FILE HEADER
          UJN    PDE5        WRITE DIRECTORY
 
*         WRITE TWO WORD DIRECTORY ENTRY.
 
 PDE4     LDCA   DA          WRITE DIRECTORY
          ADD    DI          ADD INDEX
 PDE5     CWM    **,ON       CAPSULE NAME
 PDEC     EQU    *-1
          CWM    DIRB,ON     POSITION INFORMATION
          LJM    PDE6        UPDATE REQUIRED DIRECTORY LENGTH
 
 PDED     BSS    0
          LOC    PDEA
          UJN    PDE6
          LOC    *O
 SCP      SPACE  4,25
**        SCP - SEARCH *CLD* FOR PROCEDURE RECORDS.
*                SCP SEARCHES THE *CLD* FOR A SPECIFIED PROCEDURE
*                RECORD AND THEN SETS UP THE ENTRY CONDITIONS FOR
*                *PDE* TO PROCESS THE DIRECTORY ENTRY.
*
*         ENTRY  (AB - AB+4) = NAME LEFT JUSTIFIED, ZERO FILLED.
*
*         EXIT   (TI - TI+1) = 0.
*                (PDEB) = 0.
*                (DIRA - DIRA+4) = SYSTEM LIBRARY DIRECTORY HEADER.
*                (T3) = *BUF*, WHERE *BUF* CONTAINS THE *CLD* ENTRY IN
*                       THE FOLLOWING FORMAT.
*
*T BUF    42/PROCEDURE NAME, 18/0
*T BUF+1  36/0, 24/RANDOM ADDRESS BIAS
*
*         USES   T3, T5, T6, TI - TI+1, PDEB, DIRA - DIRA+4.
*
*         CALLS  CLD.
 
 
 SCP      SUBR               ENTRY/EXIT
          LDN    ZERL        CLEAR DIRECTORY ENTRY
          CRM    DIRA,ON
          LCN    0           FORM SYSTEM LIBRARY DIRECTORY HEADER
          STM    DIRA
          RJM    CLD         SEARCH CENTRAL LIBRARY DIRECTORY
          ZJN    SCPX        IF ENTRY NOT FOUND
          CRM    BUF+5,ON      READ PST ENTRY
          LDN    0           CLEAR ALTERNATE EQ POINTER
          STD    T5
          LDD    MA          SET ENTRY POINT NAME IN BUFFER
          CWD    AB
          CRM    BUF,ON
          LDC    BUF         SET UP POINTER TO ENTRY
          STD    T3
          LDM    BUF+3
          SCN    77
          STM    BUF+3
          LDN    0
          STM    BUF+4
          STM    BUF+1*5+0
          STM    BUF+1*5+1
          STM    BUF+1*5+2
          STD    TI
          STD    TI+1
          STM    PDEB
          LDM    BUF+1*5+3
          LPN    77
          STM    BUF+1*5+3
          LDN    1
          LJM    SCPX        RETURN
 SCS      SPACE  4,15
**        SCS - SET COMPLETE STATUS.
*
*         ENTRY  (DI) = ACTUAL LENGTH OF DIRECTORY REQUIRED.
*                (SCSA) = CURRENT STATUS CODE.
*                (IR+3 - IR+4) = FET ADDRESS.
*
*         EXIT   STATUS SET IN FIRST WORD OF FET.
*                UPDATED DIRECTORY LENGTH RETURNED.
*                LOCAL FILE SET NOT BUSY IF PRESENT.
*
*         USES   GN - GN+4, CM - CM+4, FS - FS+4.
*
*         CALLS  DPP.
*
*         MACROS LDCA.
 
 
 SCS      LDC    0           SET STATUS CODE
 SCSA     EQU    *-1
          SHN    11          POSITION STATUS RESPONSE
          ADN    1           SET COMPLETE BIT
          STD    GN+4
          SHN    -14
          RAD    GN+3
          LDCA   IR+3        RETURN LENGTH OF DIRECTORY
          ADN    1
          CRD    CM
          LDD    CM+2        SET DIRECTORY LENGTH
          SCN    77
          SHN    6
          LMD    DI
          SHN    -6
          STD    CM+2
          LDD    DI
          SHN    6
          LMD    CM+3
          SCN    77
          LMD    CM+3
          STD    CM+3
          LDCA   IR+3        RETURN STATUS
          CWD    GN
          ADN    1           RETURN UPDATED DIRECTORY LENGTH
          CWD    CM
          LDN    0           SELECT DROP PP
          RJM    DPP         UPDATE ACCOUNTING
          LJM    PPR         EXIT TO PP RESIDENT
 SFE      SPACE  4,10
**        SFE - SEARCH FOR ENTRY IN CENTRAL MEMORY DIRECTORY.
*
*         ENTRY  (T3) = INDEX TO CAPSULE NAME.
*                (CL) = LENGTH OF CENTRAL MEMORY DIRECTORY.
*
*         EXIT   (A) .EQ. 0 IF MATCHING ENTRY FOUND.
*                (A) .NE. 0 IF NO MATCH FOUND.
*
*         USES   T1, CM - CM+4.
 
 
 SFE4     LDD    CM+1        COMPARE BYTE 2 OF CAPSULE NAMES
          LMM    1,T3
          NJN    SFE3        IF BYTES DO NOT COMPARE
          LDD    CM+2        COMPARE BYTE 3 OF CAPSULE NAMES
          LMM    2,T3
          NJN    SFE3        IF BYTES DO NOT COMPARE
          LDD    CM+3
          LMM    3,T3
          SCN    77
          NJN    SFE3        IF CHARACTERS DO NOT COMPARE
 
 SFE      SUBR               ENTRY/EXIT
          LDN    0           INITIALIZE DIRECTORY OFFSET
          STD    T1
 SFE1     AOD    T1          INCREMENT DIRECTORY OFFSET
 SFE2     LDCA   DA          GET DIRECTORY ENTRY
          ADD    T1
          CRD    CM
          LDD    CM
          SHN    6
          MJN    SFE1        IF FILE SPECIFICATION ENTRY
 
*         COMPARE DIRECTORY ENTRY.
 
          SHN    -6
          LMI    T3          COMPARE NAMES
          ZJN    SFE4        IF BYTES COMPARE
 SFE3     LDN    2           INCREMENT DIRECTORY OFFSET
          RAD    T1
          SBD    CL
          MJN    SFE2        IF MORE CAPSULES TO PROCESS
          LDN    1           SET EXIT CONDITION
          UJN    SFEX        RETURN
 SIS      SPACE  4,15
**        SIS - SET INTERLOCK STATUS.
*
*         ENTRY  (SISA) = TRACK NUMBER IF INTERLOCK REQUIRED.
*
*         EXIT   (CISA) = TRACK NUMBER IF INTERLOCK SET.
*                (T6) SAVED AND RESTORED.
*                TO *SCS* IF ERROR FLAG SET.
*
*         USES   T6.
*
*         CALLS  STI, SCS.
 
 
 SIS1     LDD    T6          SET TRACK INTERLOCKED STATUS
          STM    CISA
          LDC    0           RESTORE CURRENT TRACK
 SISB     EQU    *-1
          STD    T6
 
 SIS      SUBR               ENTRY/EXIT
          LDD    T6
          STM    SISB
          LDC    0           CHECK INTERLOCK REQUIRED STATUS
 SISA     EQU    *-1
          ZJN    SISX        IF NO INTERLOCK REQUIRED
          STD    T6
          RJM    STI         SET TRACK INTERLOCK
          ZJN    SIS1        IF ERROR FLAG NOT SET
          LJM    SCS         SET COMPLETE STATUS
 VOT      SPACE  4,10
**        VOT - VALIDATE *OPLD* TABLE.
*
*         ENTRY  (T3) = BUFFER ADDRESS.
*                (BL) = BUFFER LIMIT ADDRESS.
*
*         EXIT   (A) .LT. 0 IF ERROR IN TABLE.
*                (T2) = *OPLD* TABLE BASE ADDRESS.
 
 
 VOT1     LCN    1           SET EXIT CONDITION
 
 VOT      SUBR               ENTRY/EXIT
          LDM    2,T3        CHECK PREFIX TABLE
          LMC    7700
          NJN    VOT1        IF NOT 7700 TABLE
          LDM    3,T3        SET *OPLD* TABLE ADDRESS
          ADN    1
          STD    T2
          SHN    2
          RAD    T2
          ADN    2
          ADD    T3
          STD    T2
          ADN    3*5-1       CHECK MINIMUM *OPLD* IN BUFFER
          SBD    BL
          PJN    VOT1        IF *OPLD* NOT IN BUFFER
          LDI    T2          CHECK *OPLD* TABLE
          LMC    7000
          NJN    VOT1        IF NOT *OPLD* TABLE
          UJN    VOTX        RETURN
 VUT      SPACE  4,10
**        VUT - VALIDATE *ULIB* TABLES.
*
*         ENTRY  (T3) = BUFFER ADDRESS.
*                (BL) = BUFFER LIMIT ADDRESS.
*
*         EXIT   (A) = NUMBER OF GROUP NAMES IN *ULIB*.
*                (A) = 1 IF FUNCTION CODE 404.
*                (A) = 0 IF ERROR IN *ULIB* TABLE.
*                (T2) = *ULIB* TABLE BASE ADDRESS.
 
 
 VUT2     LDN    0           SET EXIT CONDITION
 
 VUT      SUBR               ENTRY/EXIT
          LDM    2,T3        CHECK PREFIX TABLE
          LMC    7700
          NJN    VUT2        IF NOT 7700 TABLE
          LDM    3,T3        SET PREFIX TABLE LENGTH
          ADN    1
          STD    T2
          SHN    2
          RAD    T2
          ADN    2
          ADD    T3
          STD    T2
          ADN    2*5-1       CHECK MINIMUM *ULIB* IN BUFFER
          SBD    BL
          PJN    VUT2        IF *ULIB* NOT IN BUFFER
          LDI    T2          CHECK *ULIB* RECORD
          LMC    7600
          NJN    VUT2        IF NOT *ULIB* RECORD
 VUTA     LDN    0
*         LDN    1           (FUNCTION CODE 404)
          ZJN    VUT1        IF NOT FUNCTION CODE 404
          UJN    VUTX        RETURN
 
 VUT1     LDM    1,T2        SET NUMBER OF GROUP NAMES IN *ULIB*
          UJN    VUTX        RETURN
          TITLE  COMMON DECKS AND BUFFERS.
 COMMON   SPACE  4,15
**        COMMON DECKS.
 
 
*CALL     COMPCLD
*CALL     COMPCRA
*CALL     COMPSAF
*CALL     COMPSFB
*CALL     COMPSTI
 
*CALL     COMPIRA
          SPACE  4,20
          USE    //
 
**        TLBD - GLOBAL LIBRARY SET.
 
 
 TLBD     EQU    *
 TLBDL    EQU    TLBD+3*5
 
 
*         RETURNED DIRECTORY ENTRY.
 
 DIRA     EQU    TLBDL
 DIRB     EQU    DIRA+1*5
 
 
**        BUF - MASS STORAGE BUFFER.
 
 
 BUF      EQU    DIRB+1*5
 
 .1       SET    BFMS+1-BUF-2
          ERRZR  .1/500      MAXIMUM SECTORS FOR BUFFER
          ERRNG  .1-.1/500*500 BYTES REMAINING BEFORE OVERFLOW
          TITLE  PRESET.
 PRS      SPACE  4,20
**        PRS - PRESET.
*
*         ENTRY  (IR - IR+4) = *LDD* CALL.
*
*         EXIT   (DI) = 0.
*                (CL) = 0.
*                (GN - GN+4) = GROUP NAME.
*                (DL) = USER SPECIFIED DIRECTORY LENGTH.
*                (DA) = DIRECTORY BASE ADDRESS.
*                (UL - UL+1) = USER SPECIFIED LIBLIST ADDRESS.
*                (LNLA) = FNT FWA.
*                TO *ERR* IF ILLEGAL PARAMETER OR ADDRESS.
*
*         USES   CL, CM - CM+4, DA, DI, DL, FA, GN - GN+4,
*                UL - UL+1, LNLA.
*
*         CALLS  CRS.
*
*         MACROS ERROR, LDCA.
 
 
 PRS      SUBR               ENTRY/EXIT
          LDN    0
          STD    DI          CLEAR DIRECTORY INDEX
          STD    FA          CLEAR FNT ADDRESS
          STD    CL          CLEAR CENTRAL DIRECTORY LENGTH
          LDD    IR+3        SET RECALL OPTION
          SHN    -5
          LPN    1
          RAM    PRSA
          LDD    IR+3        CHECK PARAMETER ADDRESS
          STM    PRSB        SAVE RECALL PARAMETERS
          LPN    37
          STD    IR+3
          SHN    14
          LMD    IR+4
          SBN    2
          MJN    PRS1        IF ILLEGAL ADDRESS
          ADN    1+2
          SHN    -6
          SBD    FL
          MJN    PRS2        IF PARAMETER ADDRESS WITHIN FL
 PRS1     ERROR  ARG         * ARGUMENT ERROR.*
 
 PRS2     RJM    CRS         CHECK RECALL STATUS
          ZJN    PRS1        IF NOT CALLED WITH AUTO RECALL
          LDCA   IR+3        READ GROUP NAME AND FUNCTION CODE
          CRD    GN
          ADN    1           READ SECOND WORD OF PARAMETER BLOCK
          CRD    CM
          LDD    GN+3        CLEAR STATUS CODE
          SCN    77
          STD    GN+3
          LDD    GN+4        CHECK FUNCTION CODE
          LPC    776
          ZJN    PRS4        IF LEGAL FUNCTION CODE
          LMC    402         CHECK FOR FUNCTION CODE 402
          ZJN    PRS2.5      IF FUNCTION CODE IS 402
          LMK    404&402     CHECK FOR FUNCTION CODE 404
          NJN    PRS3        IF ILLEGAL FUNCTION CODE
 
*         SET FUNCTION CODE 404 PROCESSING.
 
          AOM    LDDA
          AOM    PGMA
          AOM    SFGA
          AOM    VUTA
          UJN    PRS4
 
*         SET FUNCTION CODE 402 PROCESSING.
 
 PRS2.5   AOM    LDDB
          UJN    PRS4        CONTINUE PROCESSING
 
 PRS3     ERROR  ILF         ILLEGAL FUNCTION CODE
 
 PRS4     LDD    CM+2        SET LENGTH OF USER SPECIFIED DIRECTORY
          SHN    6
          STD    DL
          LDD    CM+3
          SHN    -6
          RAD    DL
          LDD    CM+3        SET DIRECTORY BASE ADDRESS
          LPN    37
          STD    DA
          SHN    14
          ADD    CM+4
          STD    DA+1
          SBN    2           CHECK DIRECTORY ADDRESS
          MJN    PRS5        IF ILLEGAL ADDRESS
          ADN    2-1
          ADD    DL
          SHN    -6
          SBD    FL
          MJN    PRS6        IF DIRECTORY ADDRESS WITHIN FL
 PRS5     ERROR  IAD         ILLEGAL DIRECTORY ADDRESS
 
 PRS6     LDD    CM+2        SET USER LIBLIST ADDRESS
          SHN    -6
          STD    UL+1
          LDD    CM+1
          SHN    6
          RAD    UL+1
          SHN    -14
          LPN    37
          STD    UL
          SHN    14          CHECK USER SPECIFIED LIBLIST ADDRESS
          LMD    UL+1
          ZJN    PRS9        IF NO LIBLIST ADDRESS SPECIFIED
          SBN    2
          MJN    PRS7        IF ILLEGAL ADDRESS
          ADN    2
          SHN    -6
          SBD    FL
          MJN    PRS9        IF USER LIBLIST ADDRESS WITHIN FL
 PRS7     ERROR  ILA         ILLEGAL LIBLIST ADDRESS
 
 PRS8     LJM    PRSX        RETURN
 
 PRS9     LDN    0           CHECK RECALL STATUS
 PRSA     EQU    *-1
*         LDN    1           (RECALL OPTION)
          ZJN    PRS8        IF NOT RECALL OPTION
          LDD    IR+2        SET DIRECTORY LENGTH PARAMETER
          STD    DI
          STD    CL          CL = MIN(DL,DI)
          SBD    DL
          MJN    PRS10       IF (DL) .LT. (DI)
          LDD    DL
          STD    CL
 PRS10    LDCA   IR+3        SET PREVIOUS ERROR CODES
          CRD    CM
          LDD    CM+3
          SHN    14
          ADD    CM+4
          SHN    -11
          STM    SCSA
          LDC    *           SET LIBRARY PARAMETERS
 PRSB     EQU    *-1
*         LDC    IR+3        (RECALL PARAMETERS)
          SHN    -6
          LPN    17
          SHN    1
          STM    GNLE
          SHN    -1
          RAM    GNLA
          LDD    CM+4        CHECK BYTE POSITION
          LPN    1
          ZJN    PRS11       IF NO REPOSITION NEEDED
          LDC    SHNI+0
          STM    GNLC
          AOM    GNLE
 PRS11    LDM    PRSB        SET LOCAL USER LIBRARY PARAMETERS
          SHN    -12
          ZJN    PRS12       IF NO LOCAL USER LIBRARIES
          RAM    CRPA        SET LIBRARY ORDINAL POSITION
          LPN    77          SET LOCAL USER LIBRARY OFFSET
          STD    CM
          SHN    2
          RAD    CM
          LDC    TLBDL
          SBD    CM
          STM    GNLB
          LDC    LB2W
          STM    GNLD
 PRS12    LJM    PRSX        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPCRS
          TTL    LDQ - LOAD QUICKLY.
          TITLE
          IDENT  LDQ,/LDQ/LDQ
*COMMENT  FDL - LOAD QUICKLY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4,5
***       LDQ - LOAD QUICKLY.
*         GREGG TOWNSEND.    76/02/04.
*         J. J. EIKUM.       76/04/01.
          SPACE  4,10
***              LDQ IS USED TO QUICKLY READ A CAPSULE OR OVERLAY INTO
*         THE FIELD LENGTH OF A JOB, GIVEN THE RANDOM ADDRESS OF THE
*         CAPSULE OR OVERLAY ON A MASS STORAGE DEVICE.  THE PREFIX
*         TABLE IS REMOVED AND THE REST OF THE RECORD IS TRANSFERRED
*         WITHOUT MODIFICATION.
          SPACE  4,10
***       CALL.
*
*
*T,       18/  *LDQ*,24/ ,18/ ADDR
*
*         ADDR   ADDRESS OF A FOUR-WORD PARAMETER BLOCK:
*
*T ADDR   42/  *FILE*,9/STAT,9/FUNC
*T,       42/  *GRPNAME*,18/0
*T,       42/  *NAME*,18/FWA
*T,       24/0,18/PRU,18/LWA+1
*
*         *FILE* FILE FROM WHICH TO LOAD.   IF BITS 59-48 = 7777,
*                THEN LOAD FROM THE SYSTEM.
*         STAT   STATUS RETURNED BY LDQ.
*                000  FUNCTION COMPLETED SUCCESSFULLY.
*                001  ILLEGAL FUNCTION.
*                002  CM BUFFER NOT COMPLETELY WITHIN FIELD LENGTH.
*                003  NO SUCH FILE, NOT MASS STORAGE, OR EXECUTE-ONLY.
*                004  PRU NUMBER OUTSIDE FILE BOUNDARIES.
*                005  WRONG PROGRAM OR GARBAGE FOUND AT SPECIFIED PRU.
*                006  INSUFFICIENT FWA-LWA SPACE TO HOLD PROGRAM.
*         FUNC   FUNCTION REQUEST.  LDQ WILL ADD 1 WHEN FINISHED.
*                000  LOAD CAPSULE.
*                002  LOAD OVERLAY.
*         *GRPNAME*  NAME OF CAPSULE GROUP.  IGNORED FOR OVERLAY LOAD.
*         *NAME* NAME OF CAPSULE OR OVERLAY TO BE LOADED.
*         FWA    FIRST WORD ADDRESS OF LOADABLE AREA.
*         LWA+1  UPPER LIMIT OF LOADABLE AREA.
*         PRU    PRU ADDRESS OF PROGRAM TO BE LOADED.
          SPACE  4,15
***       DAYFILE MESSAGES.
*
*         * LDQ - ARGUMENT ERROR - XXXXXX.* = FET ADDRESS .LT. 2 OR
*         .GT. FL-4.
*
*         * LDQ - I/O SEQUENCE ERROR - FILENAM AT XXXXXX.* = MULTIPLE
*         CONCURRENT FUNCTIONS WERE ATTEMPTED ON FILE *FILENAM*.
*
*         * LDQ - DEVICE ERROR - FILENAM AT XXXXXX.* = AN UNRECOVERED
*         DEVICE ERROR WAS ENCOUNTERED ON FILE *FILENAM*.
*
*         FOR ALL MESSAGES, XXXXXX IS THE ADDRESS OF THE *LDD*
*         PARAMETER BLOCK.
 LDQ      TITLE  MAIN PROGRAM.
          QUAL   LDQ
 
**        LDQ - MAIN PROGRAM.
 
 
          ORG    PPFW
 LDQ      RJM    PRS
          RJM    RFS         READ FIRST SECTOR
          RJM    CPY         COPY PROGRAM
*         UJN    CFN
 CFN      SPACE  4,10
**        CFN - COMPLETE FUNCTION.
 
 
 CFN      AOD    FN+4        SET PARAMETER BLOCK COMPLETE
          LDCA   IR+3        REWRITE FIRST PARAMETER WORD
          CWD    FN
*         UJN    DPP
 DPP      SPACE  4,10
**        DPP - DROP PP.
 
 
 DPP      LDD    FA
          ZJN    DPP1        IF NOT LOCAL FILE LOAD
          AOD    FS+4
          NFA    FA,R        SET FST NOT BUSY
          ADN    FSTL
          CWD    FS
 DPP1     LDD    MA          STORE *UADM* PARAMETER BLOCK
          CWM    DPPA,ON
          LDN    1           SET WORD COUNT
          STD    CM+1
          LDN    0           SET DROP PP FLAG
          STD    CM+2
          MONITOR UADM       UPDATE ACCOUNTING AND DROP PP
          LJM    PPR
 
 
 DPPA     CON    AISS        SUB FUNCTION
          CON    IOAW        WORD TO UPDATE
          CON    40D*100+20D FIELD TO UPDATE
          CON    0,0         INCREMENT
          TITLE  SUBROUTINES.
          SPACE  4,10
**        COMMON SUBROUTINES.
 
 
          COMMON
 CPN      SPACE  4,12
**        CPN - COMPARE NAMES.
*
*         ENTRY  (A) = ADDRESS OF NAME 1.
*                (GN - GN+3) = NAME 2.
*
*         EXIT   (A) = 0 IF SEVEN CHARACTERS MATCH.
*
*         USES   T2.
 
 
 CPN      SUBR               ENTRY/EXIT
          STD    T2
          LDI    T2          COMPARE FIRST BYTES
          LMD    GN
          NJN    CPNX        IF NOT EQUAL
          LDM    1,T2        COMPARE SECOND BYTES
          LMD    GN+1
          NJN    CPNX        IF NOT EQUAL
          LDM    2,T2        COMPARE THIRD BYTES
          LMD    GN+2
          NJN    CPNX        IF NOT EQUAL
          LDM    3,T2        COMPARE SEVENTH CHARACTERS
          LMD    GN+3
          SCN    77
          UJN    CPNX        RETURN WITH (A)=0 ONLY IF MATCH
 CPY      SPACE  4,25
**        CPY - COPY PROGRAM.
*
*         ENTRY  (T1) = VALID WORD COUNT.
*                (T3) = ADDRESS OF WORDS IN PP BUFFER.
*                (T5) = EST ORDINAL.
*                (T6) = TRACK.
*                (T7) = SECTOR.
*                (ER) = EOR FLAG.
*                (FW - FW+1) = FWA OF CM BUFFER.
*                (BS - BS+1) = BUFFER SIZE.
*                (BFMS - BFMS+501) = FIRST SECTOR.
*
*         EXIT   TO *ERR* IF CM BUFFER TOO SMALL.
*                CHANNEL DROPPED.
*
*         USES   T1, T3, T6, T7, CM - CM+4, FW - FW+1, BS - BS+1,
*                EC, ER.
*
*         CALLS  CIS, DDT, MSR, RNS.
*
*         MACROS ENDMS, ERROR.
 
 
*         PROCESS DIRECT TRANSFER COPY.
 
 CPY4     LDD    FW          SET *DDT* PARAMETERS
          ADD    BS
          SHN    14
          ADD    FW+1
          ADD    BS+1
          SHN    14
          STD    CM+2
          SHN    -6
          SCN    77
          ADD    FW
          STD    CM+3
          LDD    FW+1
          STD    CM+4
          LDC    RDDS*10000+7777
          RJM    DDT         DO DIRECT TRANSFER
          SHN    -14
          STD    EC          SAVE STATUS
          LDD    T4          NUMBER OF SECTORS TRANSFERED
          RAM    DPPA+4      UPDATE ACCOUNT INCREMENT
          ERRNZ  IMLL-1      CODE DEPENDS ON VALUE
          SHN    -14
          RAM    DPPA+3
          LDD    EC
          ZJN    CPY6        IF NO ERRORS
          SHN    21-4
          MJN    CPY5        IF INSUFFICIENT FL TO LOAD
          LDM    RDCT
          RJM    MSR         PROCESS MASS STORAGE ERROR
 
 CPY5     ENDMS
          ERROR  IBF         INSUFFICIENT BUFFER
 
 CPY6     ENDMS
          RJM    CIS         CLEAR INTERLOCK STATUS
 
 CPY      SUBR               ENTRY/EXIT
 CPY1     LDD    BS          DECREMENT BUFFER SIZE
          SHN    14
          LMD    BS+1
          SBD    T1
          MJN    CPY5        IF BUFFER TOO SMALL
          STD    BS+1
          SHN    -14
          STD    BS
          LDD    T3          SET PP BUFFER ADDRESS
          STM    CPYA
          LDCA   FW          WRITE BUFFER TO CM
          CWM    **,T1
 CPYA     EQU    *-1
          LDD    T1          UPDATE FWA
          RAD    FW+1
          SHN    -14
          RAD    FW
          LDD    ER
          NJN    CPY3        IF EOR NOT READ
 CPY2     LJM    CPY6        EXIT
 
 CPY3     LDC    BFMS        READ NEXT SECTOR
 CPYC     EQU    *-1
*         LJM    CPY4        (DIRECT TRANSFER COPY)
          RJM    RNS
          SHN    -6          SAVE EOR FLAG
          STD    ER
          LDN    IMLL        INCREMENT PRU COUNT
          RAM    DPPA+4
          SHN    -14
          RAM    DPPA+3
          LDD    T1
          ZJN    CPY2        IF EMPTY PRU
          LDN    2           ADJUST FWA TO SKIP HEADER
          RAD    T3
          LJM    CPY1        LOOP
 ERR      SPACE  4,10
**        ERR - SET ERROR AND EXIT.
*
*         ENTRY  (A) = ERROR CODE.
*                (DPPA+3 - DPPA+4) = MASS STORAGE INCREMENT.
*
*         EXIT   TO *2LD* IF FATAL ERROR.
*                TO *CFN* IF NON-FATAL ERROR.
*                (BITS 11-13 OF FN+4) = STATUS.
*
*         USES   EC, SI, SI+1.
*
*         CALLS  CFN, CIS.
 
 
 ERR      SUBR
          STD    EC          SAVE ERROR CODE
          RJM    CIS         CLEAR INTERLOCK STATUS
 
 ERR1     LDD    EC          CHECK ERROR TYPE
          SBN    /ERR/FERT
          MJN    ERR2        IF NON-FATAL ERROR
          LDM    DPPA+3      SET ACCOUNTING INCREMENT
          STD    SI
          LDM    DPPA+4
          STD    SI+1
          EXECUTE 2LD        PROCESS ERROR
 
 ERR2     LDD    EC          SET STATUS FIELD
          SHN    11
          RAD    FN+4
          LJM    CFN         EXIT
 RFS      SPACE  4,25
**        RFS - READ FIRST SECTOR.
*
*         ENTRY  (T4) = CHANNEL.
*                (T5) = EST ORDINAL.
*                (T6) = TRACK.
*                (T7) = SECTOR.
*                (GN - GN+3) = OVERLAY/CAPSULE NAME.
*
*         EXIT   TO *ERR* IF ERROR DETECTED.
*                (T1) = VALID WORD COUNT.
*                (T3) = ADDRESS OF WORDS IN PP BUFFER.
*                (T6) = CURRENT TRACK.
*                (T7) = NEXT SECTOR.
*                (ER) = 0 IF EOR.
*
*         USES   T2, CM - CM+4, GN - GN+4.
*
*         CALLS  CPN, RNS.
*
*         MACROS ENDMS, ERROR.
 
 
 RFS      SUBR               ENTRY/EXIT
          LDN    IMLL        INCREMENT PRU COUNT
          RAM    DPPA+4
          LDC    BFMS        READ FIRST SECTOR
          RJM    RNS
          SHN    -6          SAVE EOR FLAG
          STD    ER
          LDN    2           ADJUST BUFFER POINTER TO SKIP HEADER
          RAD    T3
          LDI    T3          CHECK FIRST WORD
          LMC    7700
          NJN    RFS1        IF NOT 7700 TABLE (ERROR)
          LDD    T3          COMPARE CAPSULE/OVERLAY NAME TO EXPECTED
          ADN    5
          RJM    CPN
          NJN    RFS1        IF NOT SAME NAME
          LDM    1,T3        SKIP 7700 TABLE
          ADN    1           ENSURE 7700 HEADER IN SECTOR
          STD    T2
          SHN    2
          ADD    T2
          RAD    T3
          LDD    T1          ADJUST WORD COUNT
          SBD    T2
          MJN    RFS1        IF WORD COUNT IN 77 TABLE .GT. SECTOR SIZE
          STD    T1
          LDD    FN+4
          ZJN    RFS2        IF LOADING A CAPSULE
          LDI    T3
          SHN    -6
          SBN    50
          MJN    RFS1        IF .LT. 50XX TABLE
          SBN    52-50
          ZJN    RFS1        IF 52XX TABLE
          SBN    54-52+1
          PJN    RFS1        IF .GT. 54XX TABLE
          LJM    RFSX        VALID OVERLAY FORMAT, EXIT
 
 RFS1     ENDMS
          ERROR  WPR         WRONG PROGRAM
 
 RFS2     LDI    T3          CHECK HEADER
          LMC    6000
          NJN    RFS1        IF NOT CAPSULE
          LDCA   IR+3        READ GROUP NAME
          ADN    1
          CRD    GN
          LDD    T3
          ADN    5
          RJM    CPN         COMPARE WITH ACTUAL READ
          NJN    RFS1        IF NOT SAME NAME
          LJM    RFSX        RETURN
          SPACE  4
**        COMMON DECKS.
 
 
*CALL     COMPDDT
 PRS      TITLE  PRESET.
**        PRS - PRESET.
*
*         ENTRY  (IR - IR+4) = LDQ  CALL.
*
*         EXIT   TO *ERR* IF ERROR DETECTED.
*                (FA) = 0 IF SYSTEM FILE.
*                (FA) = FNT ADDRESS IF LOCAL FILE.
*                (FS - FS+4) = FST ENTRY IF LOCAL FILE.
*                (FN - FN+3) = FILE NAME.
*                (FN+4) = FUNCTION CODE.
*                (FW - FW+1) = FWA OF BUFFER.
*                (BL - BL+1) = BUFFER LENGTH.
*                (GN - GN+3) = OVERLAY/CAPSULE NAME.
*                (T4) = CHANNEL.
*                (T5) = EST ORDINAL.
*                (T6) = TRACK.
*                (T7) = SECTOR.
*                CHANNEL RESERVED AND DISK POSITIONED.
*                ERROR PROCESSING OPTION SET.
*
*         USES   CM - CM+4, GN - GN+4.
*
*         CALLS  ALF, ASF, CRA, IRA, SMS, POS.
 
 
 PRS      SUBR               ENTRY/EXIT
          LDN    0
          STD    FA
          LDD    IR+3        CHECK PARAMETER BLOCK ADDRESS
          LPN    37
          STD    IR+3
          SHN    14
          LMD    IR+4
          SBN    2
          MJN    PRS1        IF ILLEGAL ADDRESS
          ADN    3+2
          SHN    -6
          SBD    FL
          MJN    PRS2        IF LEGAL ADDRESS
 PRS1     ERROR  ARG         * ARGUMENT ERROR.*
 
 PRS2     LDCA   IR+3        READ FILE NAME AND FUNCTION CODE
          CRD    FN
          ADN    2           READ FWA OF BUFFER
          CRD    CM
          ADN    1           READ RANDOM INDEX AND LWA
          CRD    GN
          LDD    FN+3        CLEAR STATUS FIELD
          SCN    77
          STD    FN+3
          LDD    FN+4
          LPC    776
          STD    FN+4
          SHN    -1
          SBN    2
          MJN    PRS3        IF LEGAL FUNCTION CODE
          ERROR  ILF         ILLEGAL FUNCTION
 
 PRS3     LDD    CM+3        SET FWA OF BUFFER
          LPN    37
          STD    FW
          SHN    14
          LMD    CM+4
          STD    FW+1
          SBN    2
          MJN    PRS4        IF ILLEGAL ADDRESS
          LDD    GN+3        CHECK LWA+1 OF BUFFER
          LPN    37
          SHN    14
          LMD    GN+4
          SBN    1
          SHN    -6
          SBD    FL
          MJN    PRS5        IF LEGAL ADDRESS
 PRS4     ERROR  IAD         ILLEGAL ADDRESS
 
 PRS5     LDD    GN+3        SET BUFFER LENGTH
          LPN    37
          SHN    14
          LMD    GN+4
          SBD    FW+1
          STD    BS+1
          SHN    -14
          SBD    FW
          STD    BS
          SHN    14
          LMD    BS+1
          MJN    PRS4        IF FWA .GT. LWA+1
          ZJN    PRS4        IF FWA .EQ. LWA+1
          LDD    GN+3        SET RANDOM INDEX
          SCN    77
          SHN    6
          LMD    GN+2
          SHN    6
          ZJN    PRS8        IF ILLEGAL RANDOM ADDRESS
          STD    RI+1
          SHN    -14
          LPN    77
          STD    RI
          LDCA   IR+3        READ OVERLAY/CAPSULE NAME
          ADN    2
          CRD    GN
 
*         ACCESS FILE.
 
          LDD    FN          CHECK FILE TYPE
          LMC    7777
          ZJN    PRS6        IF SYSTEM FILE
          RJM    ALF         ACCESS LOCAL FILE
          UJN    PRS7
 
 PRS6     RJM    ASF         ACCESS SYSTEM FILE
 PRS7     RJM    IRA         INITIALIZE RANDOM ACCESS
          RJM    CRA         CONVERT RANDOM ADDRESS
          PJN    PRS9        IF LEGAL RANDOM ADDRESS
 PRS8     ERROR  IRA         ILLEGAL RANDOM ADDRESS
 
*         RESERVE CHANNEL.
 
 PRS9     LDD    FA
          NJN    PRS10       IF NOT SYSTEM FILE
          SETMS  READSYS     ALLOW SYSTEM SELECTION OF EQUIPMENT
          UJN    PRS11       CHECK IF DIRECT TRANSFER SUPPORTED
 
*         PRESET FOR DIRECT TRANSFER IF AVAILABLE.
 
 PRS10    SETMS  IO
 PRS11    LDD    CM+4
          SHN    3
          ADN    DILL
          CRD    CM
          LDD    CM+3
          SHN    21-13
          PJN    PRS12       IF DIRECT TRANSFER NOT AVAILABLE
          LDC    CPY4        PRESET *CPY* FOR DIRECT TRANSFER
          STM    CPYC
          LDC    LJMI
          STM    CPYC-1
 PRS12    LJM    PRSX        RETURN
 ALF      SPACE  4,20
**        ALF - ACCESS LOCAL FILE.
*
*         ENTRY  (FN - FN+3) = FILE NAME.
*
*         EXIT   TO *ERR* IF ERROR.
*                (T5) = EST ORDINAL.
*                (T6) = FIRST TRACK.
*                (FA) = FNT ADDRESS.
*                (FS - FS+4) = FST ENTRY.
*                TRACK INTERLOCK SET IF NEEDED.
*
*         USES   CM - CM+4, FN - FN+4, RI - RI+4, T0 - T6.
*
*         CALLS  ERR, SAF, SFB, STI.
*
*         MACROS ERROR, NFA, SFA.
 
 
 ALF6     RJM    SFB         SET FILE BUSY
          ZJN    ALF2        IF FILE SET BUSY
          ERROR  IOS         I/O SEQUENCE ERROR
 
 ALF      SUBR               ENTRY/EXIT
          LDD    FN          CLEAR UPPER BIT
          LPC    3777
          STD    FN
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          NJN    ALF6        IF FILE FOUND
 ALF1     ERROR  FNF         FILE NOT FOUND
 
 ALF2     LDD    CM+3        CHECK FILE STATUS
          LPN    4
          ZJN    ALF3        IF NOT EXECUTE ONLY
          LDD    CP          CHECK VALID ACCESS
          ADC    EOCW
          CRD    T1
          LDD    T1
          LMD    FA
          NJN    ALF1        IF NOT VALID ACCESS
 ALF3     NFA    FA,R        RESET FST INFORMATION
          ADN    FSTL
          CRD    FS
          LDD    FS+2
          ZJN    ALF1        IF EMPTY FILE
          LDD    FS          SET EST ORDINAL
          STD    T5
          SFA    EST         READ EST ENTRY
          ADK    EQDE
          CRD    T0
          LDD    T0          CHECK EQUIPMENT TYPE
          SHN    21-13
          PJN    ALF1        IF NOT ON MASS STORAGE
          LDD    FS+1        SET FIRST TRACK
          STD    T6
          LDD    CM+4        CHECK FOR TRACK INTERLOCK NEEDED
          SHN    -6
          LMN    PMFT
          NJN    ALF5        IF NOT PERMANENT FILE
          LDD    CM+3
          LPN    20
          ZJN    ALF5        IF NOT M, A, RM, OR RA MODE
          RJM    STI         SET TRACK INTERLOCK
          ZJN    ALF4        IF INTERLOCK SET AND ERROR FLAG NOT SET
          LJM    DPP
 
 ALF4     LDD    T6          SET TRACK INTERLOCKED STATUS
          STM    CISA
 ALF5     LJM    ALFX
 ASF      SPACE  4,12
**        ASF - ACCESS SYSTEM FILE.
*
*         EXIT   (T5) = EST ORDINAL.
*                (T6) = FIRST TRACK.
*
*         USES   CM - CM+4.
 
 
 ASF      SUBR               ENTRY/EXIT
          LDN    FNTP        READ FNT POINTER
          CRD    CM
          LDD    CM          READ SYSTEM FILE FST
          SHN    14
          LMD    CM+1
          ERRNZ  SYFO        SYSTEM FILE ORDINAL .NE. 0
          ADN    FSTG
          CRD    CM
          LDD    CM+1        SET FIRST TRACK
          STD    T6
          LDD    CM          SET SYSTEM EQUIPMENT
          STD    T5
          UJN    ASFX
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPCRA
*CALL     COMPSAF
*CALL     COMPSFB
*CALL     COMPSTI
 
*CALL     COMPIRA
          TTL    2LD - PROCESS LDD/LDQ ERRORS.
          TITLE
          IDENT  2LD,PPFW
          QUAL   2LD
*COMMENT  FDL - ERROR PROCESSOR.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 ERP      SPACE  4,10
**        ERP - ERROR PROCESSOR.
*
*         ENTRY  (EC) = ERROR CODE.
*                (FA) = FNT ADDRESS IF LOCAL FILE.
*                (FA) = 0 IF SYSTEM FILE.
*                (SI - SI+1) = MASS STORAGE ACCOUNTING INCREMENT.
*                (FN - FN+3) = FILE NAME.
*                (IR - IR+1) = PP NAME.
*                (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS.
*
*         EXIT   LOCAL FILE SET COMPLETE.
*                MESSAGE ISSUED.
*                ACCOUNTING UPDATED.
*                PPU DROPPED.
*
*         USES   T1, CM - CM+4.
*
*         CALLS  ACS, ANS, DFM.
*
*         MACROS MONITOR, NFA, PAUSE.
 
 
          ORG    PPFW
 ERP      SUBR
          LDC    BUF         SET ADDRESS FOR PROCESSOR NAME
          STD    T1
          LDN    1R          ADD SPACE CHARACTER
          SHN    14
          ADD    IR          SET FIRST CHARACTER
          SHN    14
          STI    T1
          LMI    T1          SET LAST CHARACTERS
          ADD    IR+1
          SHN    14
          STM    BUF+1
          LDN    2           SET ASSEMBLY ADDRESS
          RAD    T1
          LDN    0           SET BYTE BOUNDARY
          STI    T1
          LDC    =Z* - *     ADD * - *
          RJM    ACS
          LDD    EC          ADD MESSAGE
          SBN    /ERR/FERT
          STD    T2
          LDM    TMSG,T2
          RJM    ACS
          LDC    =Z* - *     ADD * - *
          RJM    ACS
          LDD    EC          CHECK ERROR TYPE
          LMN    /ERR/ARG
          ZJN    ERP3        IF * ARGUMENT ERROR.*
          LDD    FA
          NJN    ERP1        IF LOCAL FILE
          LDC    =Z*SYSTEM*
          UJN    ERP2
 
 ERP1     LDD    FN+3        TERMINATE FILE NAME
          SCN    77
          STD    FN+3
          LDN    FN          ADD FILE NAME
 ERP2     RJM    ACS
          LDC    =Z* AT *    ADD * AT *
          RJM    ACS
 ERP3     LDD    IR+3        ADD ADDRESS
          SHN    14
          LMD    IR+4
          RJM    ANS
          LDC    =Z*.*       ADD PERIOD
          RJM    ACS
          LDC    BUF         ISSUE DAYFILE MESSAGE
          RJM    DFM
          PAUSE              CHECK ERROR FLAG
          LDD    CM+1
          NJN    ERP4        IF ERROR FLAG SET
          LDN    PPET        SET ERROR FLAG
          STD    CM+1
          MONITOR CEFM
 ERP4     AOD    FS+4        SET FST ENTRY COMPLETE
          LDD    EC          CHECK ERROR TYPE
          LMN    /ERR/IOS
          ZJN    ERP5        IF I/O SEQUENCE ERROR
          LDD    FA
          ZJN    ERP5        IF NO FST ADDRESS
          NFA    FA,R
          ADN    FSTL
          CWD    FS
 
 ERP5     LDD    SI          SET ACCOUNTING INCREMENT
          STM    ERPC
          LDD    SI+1
          STM    ERPC+1
          LDD    MA          SET REQUEST IN MESSAGE BUFFER
          CWM    ERPB,ON
          LDN    1           SET WORD COUNT
          STD    CM+1
          LDN    0           SET DROP PPU
          STD    CM+2
          MONITOR UADM
          LJM    PPR
 
 ERPB     CON    AISS        SUB FUNCTION
          CON    IOAW        WORD TO UPDATE
          CON    40D*100+20D FIELD TO UPDATE
 ERPC     CON    0,0         INCREMENT
 TMSG     SPACE  4
 TMSG     BSS    0
          QUAL   ERR
          LOC    FERT
 ARG      MSG    (ARGUMENT ERROR)
 IOS      MSG    (I/O SEQUENCE ERROR)
 MSR      MSG    (DEVICE ERROR)
          LOC    *O
          QUAL   *
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPACS
*CALL     COMPANS
 BUF      SPACE  4,10
          USE    BUFFERS
 BUF      BSS    0           ASSEMBLY BUFFER
          SPACE  4
          TTL    LDD/LDQ - FAST DYNAMIC LOADER.
          END