FDL 
          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 
